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. */
49 /* Structure for holding module and include file search path. */
50 typedef struct gfc_directorylist
54 struct gfc_directorylist *next;
58 /* List of include file search directories. */
59 static gfc_directorylist *include_dirs, *intrinsic_modules_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);
118 /* Adds path to the list pointed to by list. */
121 add_path_to_list (gfc_directorylist **list, const char *path,
122 bool use_for_modules)
124 gfc_directorylist *dir;
128 while (*p == ' ' || *p == '\t') /* someone might do "-I include" */
134 dir = *list = gfc_getmem (sizeof (gfc_directorylist));
140 dir->next = gfc_getmem (sizeof (gfc_directorylist));
145 dir->use_for_modules = use_for_modules;
146 dir->path = gfc_getmem (strlen (p) + 2);
147 strcpy (dir->path, p);
148 strcat (dir->path, "/"); /* make '/' last character */
153 gfc_add_include_path (const char *path, bool use_for_modules)
155 add_path_to_list (&include_dirs, path, use_for_modules);
160 gfc_add_intrinsic_modules_path (const char *path)
162 add_path_to_list (&intrinsic_modules_dirs, path, true);
166 /* Release resources allocated for options. */
169 gfc_release_include_path (void)
171 gfc_directorylist *p;
173 while (include_dirs != NULL)
176 include_dirs = include_dirs->next;
181 while (intrinsic_modules_dirs != NULL)
183 p = intrinsic_modules_dirs;
184 intrinsic_modules_dirs = intrinsic_modules_dirs->next;
189 gfc_free (gfc_option.module_dir);
194 open_included_file (const char *name, gfc_directorylist *list, bool module)
197 gfc_directorylist *p;
200 for (p = list; p; p = p->next)
202 if (module && !p->use_for_modules)
205 fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
206 strcpy (fullname, p->path);
207 strcat (fullname, name);
209 f = gfc_open_file (fullname);
218 /* Opens file for reading, searching through the include directories
219 given if necessary. If the include_cwd argument is true, we try
220 to open the file in the current directory first. */
223 gfc_open_included_file (const char *name, bool include_cwd, bool module)
227 if (IS_ABSOLUTE_PATH (name))
228 return gfc_open_file (name);
232 f = gfc_open_file (name);
237 return open_included_file (name, include_dirs, module);
241 gfc_open_intrinsic_module (const char *name)
243 if (IS_ABSOLUTE_PATH (name))
244 return gfc_open_file (name);
246 return open_included_file (name, intrinsic_modules_dirs, true);
250 /* Test to see if we're at the end of the main source file. */
259 /* Test to see if we're at the end of the current file. */
267 if (line_head == NULL)
268 return 1; /* Null file */
270 if (gfc_current_locus.lb == NULL)
277 /* Test to see if we're at the beginning of a new line. */
285 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
289 /* Test to see if we're at the end of a line. */
297 return (*gfc_current_locus.nextc == '\0');
301 /* Advance the current line pointer to the next line. */
304 gfc_advance_line (void)
309 if (gfc_current_locus.lb == NULL)
315 gfc_current_locus.lb = gfc_current_locus.lb->next;
317 if (gfc_current_locus.lb != NULL)
318 gfc_current_locus.nextc = gfc_current_locus.lb->line;
321 gfc_current_locus.nextc = NULL;
327 /* Get the next character from the input, advancing gfc_current_file's
328 locus. When we hit the end of the line or the end of the file, we
329 start returning a '\n' in order to complete the current statement.
330 No Fortran line conventions are implemented here.
332 Requiring explicit advances to the next line prevents the parse
333 pointer from being on the wrong line if the current statement ends
341 if (gfc_current_locus.nextc == NULL)
344 c = (unsigned char) *gfc_current_locus.nextc++;
347 gfc_current_locus.nextc--; /* Remain on this line. */
355 /* Skip a comment. When we come here the parse pointer is positioned
356 immediately after the comment character. If we ever implement
357 compiler directives withing comments, here is where we parse the
361 skip_comment_line (void)
375 /* Comment lines are null lines, lines containing only blanks or lines
376 on which the first nonblank line is a '!'.
377 Return true if !$ openmp conditional compilation sentinel was
381 skip_free_comments (void)
389 at_bol = gfc_at_bol ();
390 start = gfc_current_locus;
396 while (gfc_is_whitespace (c));
406 /* If -fopenmp, we need to handle here 2 things:
407 1) don't treat !$omp as comments, but directives
408 2) handle OpenMP conditional compilation, where
409 !$ should be treated as 2 spaces (for initial lines
410 only if followed by space). */
411 if (gfc_option.flag_openmp && at_bol)
413 locus old_loc = gfc_current_locus;
414 if (next_char () == '$')
417 if (c == 'o' || c == 'O')
419 if (((c = next_char ()) == 'm' || c == 'M')
420 && ((c = next_char ()) == 'p' || c == 'P')
421 && ((c = next_char ()) == ' ' || continue_flag))
423 while (gfc_is_whitespace (c))
425 if (c != '\n' && c != '!')
428 openmp_locus = old_loc;
429 gfc_current_locus = start;
433 gfc_current_locus = old_loc;
437 if (continue_flag || c == ' ')
439 gfc_current_locus = old_loc;
445 gfc_current_locus = old_loc;
447 skip_comment_line ();
454 if (openmp_flag && at_bol)
456 gfc_current_locus = start;
461 /* Skip comment lines in fixed source mode. We have the same rules as
462 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
463 in column 1, and a '!' cannot be in column 6. Also, we deal with
464 lines with 'd' or 'D' in column 1, if the user requested this. */
467 skip_fixed_comments (void)
475 start = gfc_current_locus;
480 while (gfc_is_whitespace (c));
485 skip_comment_line ();
490 gfc_current_locus = start;
497 start = gfc_current_locus;
508 if (c == '!' || c == 'c' || c == 'C' || c == '*')
510 /* If -fopenmp, we need to handle here 2 things:
511 1) don't treat !$omp|c$omp|*$omp as comments, but directives
512 2) handle OpenMP conditional compilation, where
513 !$|c$|*$ should be treated as 2 spaces if the characters
514 in columns 3 to 6 are valid fixed form label columns
516 if (gfc_option.flag_openmp)
518 if (next_char () == '$')
521 if (c == 'o' || c == 'O')
523 if (((c = next_char ()) == 'm' || c == 'M')
524 && ((c = next_char ()) == 'p' || c == 'P'))
528 && ((openmp_flag && continue_flag)
529 || c == ' ' || c == '0'))
532 while (gfc_is_whitespace (c))
534 if (c != '\n' && c != '!')
536 /* Canonicalize to *$omp. */
539 gfc_current_locus = start;
549 for (col = 3; col < 6; col++, c = next_char ())
552 else if (c < '0' || c > '9')
557 if (col == 6 && c != '\n'
558 && ((continue_flag && !digit_seen)
559 || c == ' ' || c == '0'))
561 gfc_current_locus = start;
562 start.nextc[0] = ' ';
563 start.nextc[1] = ' ';
568 gfc_current_locus = start;
570 skip_comment_line ();
574 if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
576 if (gfc_option.flag_d_lines == 0)
578 skip_comment_line ();
582 *start.nextc = c = ' ';
587 while (gfc_is_whitespace (c))
599 if (col != 6 && c == '!')
601 skip_comment_line ();
609 gfc_current_locus = start;
613 /* Skips the current line if it is a comment. */
616 gfc_skip_comments (void)
618 if (gfc_current_form == FORM_FREE)
619 skip_free_comments ();
621 skip_fixed_comments ();
625 /* Get the next character from the input, taking continuation lines
626 and end-of-line comments into account. This implies that comment
627 lines between continued lines must be eaten here. For higher-level
628 subroutines, this flattens continued lines into a single logical
629 line. The in_string flag denotes whether we're inside a character
633 gfc_next_char_literal (int in_string)
636 int i, c, prev_openmp_flag;
648 if (gfc_current_form == FORM_FREE)
650 bool openmp_cond_flag;
652 if (!in_string && c == '!')
655 && memcmp (&gfc_current_locus, &openmp_locus,
656 sizeof (gfc_current_locus)) == 0)
659 /* This line can't be continued */
666 /* Avoid truncation warnings for comment ending lines. */
667 gfc_current_locus.lb->truncated = 0;
675 /* If the next nonblank character is a ! or \n, we've got a
676 continuation line. */
677 old_loc = gfc_current_locus;
680 while (gfc_is_whitespace (c))
683 /* Character constants to be continued cannot have commentary
686 if (in_string && c != '\n')
688 gfc_current_locus = old_loc;
693 if (c != '!' && c != '\n')
695 gfc_current_locus = old_loc;
700 prev_openmp_flag = openmp_flag;
703 skip_comment_line ();
708 goto not_continuation;
710 /* We've got a continuation line. If we are on the very next line after
711 the last continuation, increment the continuation line count and
712 check whether the limit has been exceeded. */
713 if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
715 if (++continue_count == gfc_option.max_continue_free)
717 if (gfc_notification_std (GFC_STD_GNU) || pedantic)
718 gfc_warning ("Limit of %d continuations exceeded in "
719 "statement at %C", gfc_option.max_continue_free);
722 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
724 /* Now find where it continues. First eat any comment lines. */
725 openmp_cond_flag = skip_free_comments ();
727 if (prev_openmp_flag != openmp_flag)
729 gfc_current_locus = old_loc;
730 openmp_flag = prev_openmp_flag;
735 /* Now that we have a non-comment line, probe ahead for the
736 first non-whitespace character. If it is another '&', then
737 reading starts at the next character, otherwise we must back
738 up to where the whitespace started and resume from there. */
740 old_loc = gfc_current_locus;
743 while (gfc_is_whitespace (c))
748 for (i = 0; i < 5; i++, c = next_char ())
750 gcc_assert (TOLOWER (c) == "!$omp"[i]);
752 old_loc = gfc_current_locus;
754 while (gfc_is_whitespace (c))
762 if (gfc_option.warn_ampersand)
763 gfc_warning_now ("Missing '&' in continued character "
765 gfc_current_locus.nextc--;
767 /* Both !$omp and !$ -fopenmp continuation lines have & on the
768 continuation line only optionally. */
769 else if (openmp_flag || openmp_cond_flag)
770 gfc_current_locus.nextc--;
774 gfc_current_locus = old_loc;
781 /* Fixed form continuation. */
782 if (!in_string && c == '!')
784 /* Skip comment at end of line. */
791 /* Avoid truncation warnings for comment ending lines. */
792 gfc_current_locus.lb->truncated = 0;
798 prev_openmp_flag = openmp_flag;
800 old_loc = gfc_current_locus;
803 skip_fixed_comments ();
805 /* See if this line is a continuation line. */
806 if (openmp_flag != prev_openmp_flag)
808 openmp_flag = prev_openmp_flag;
809 goto not_continuation;
813 for (i = 0; i < 5; i++)
817 goto not_continuation;
820 for (i = 0; i < 5; i++)
823 if (TOLOWER (c) != "*$omp"[i])
824 goto not_continuation;
828 if (c == '0' || c == ' ' || c == '\n')
829 goto not_continuation;
831 /* We've got a continuation line. If we are on the very next line after
832 the last continuation, increment the continuation line count and
833 check whether the limit has been exceeded. */
834 if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
836 if (++continue_count == gfc_option.max_continue_fixed)
838 if (gfc_notification_std (GFC_STD_GNU) || pedantic)
839 gfc_warning ("Limit of %d continuations exceeded in "
841 gfc_option.max_continue_fixed);
845 if (continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
846 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
849 /* Ready to read first character of continuation line, which might
850 be another continuation line! */
855 gfc_current_locus = old_loc;
865 /* Get the next character of input, folded to lowercase. In fixed
866 form mode, we also ignore spaces. When matcher subroutines are
867 parsing character literals, they have to call
868 gfc_next_char_literal(). */
877 c = gfc_next_char_literal (0);
879 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
891 old_loc = gfc_current_locus;
892 c = gfc_next_char ();
893 gfc_current_locus = old_loc;
899 /* Recover from an error. We try to get past the current statement
900 and get lined up for the next. The next statement follows a '\n'
901 or a ';'. We also assume that we are not within a character
902 constant, and deal with finding a '\'' or '"'. */
905 gfc_error_recovery (void)
914 c = gfc_next_char ();
915 if (c == '\n' || c == ';')
918 if (c != '\'' && c != '"')
947 /* Read ahead until the next character to be read is not whitespace. */
950 gfc_gobble_whitespace (void)
952 static int linenum = 0;
958 old_loc = gfc_current_locus;
959 c = gfc_next_char_literal (0);
960 /* Issue a warning for nonconforming tabs. We keep track of the line
961 number because the Fortran matchers will often back up and the same
962 line will be scanned multiple times. */
963 if (!gfc_option.warn_tabs && c == '\t')
965 #ifdef USE_MAPPED_LOCATION
966 int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
968 int cur_linenum = gfc_current_locus.lb->linenum;
970 if (cur_linenum != linenum)
972 linenum = cur_linenum;
973 gfc_warning_now ("Nonconforming tab character at %C");
977 while (gfc_is_whitespace (c));
979 gfc_current_locus = old_loc;
983 /* Load a single line into pbuf.
985 If pbuf points to a NULL pointer, it is allocated.
986 We truncate lines that are too long, unless we're dealing with
987 preprocessor lines or if the option -ffixed-line-length-none is set,
988 in which case we reallocate the buffer to fit the entire line, if
990 In fixed mode, we expand a tab that occurs within the statement
991 label region to expand to spaces that leave the next character in
993 load_line returns whether the line was truncated.
995 NOTE: The error machinery isn't available at this point, so we can't
996 easily report line and column numbers consistent with other
997 parts of gfortran. */
1000 load_line (FILE *input, char **pbuf, int *pbuflen)
1002 static int linenum = 0, current_line = 1;
1003 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
1004 int trunc_flag = 0, seen_comment = 0;
1005 int seen_printable = 0, seen_ampersand = 0;
1008 /* Determine the maximum allowed line length. */
1009 if (gfc_current_form == FORM_FREE)
1010 maxlen = gfc_option.free_line_length;
1011 else if (gfc_current_form == FORM_FIXED)
1012 maxlen = gfc_option.fixed_line_length;
1018 /* Allocate the line buffer, storing its length into buflen.
1019 Note that if maxlen==0, indicating that arbitrary-length lines
1020 are allowed, the buffer will be reallocated if this length is
1021 insufficient; since 132 characters is the length of a standard
1022 free-form line, we use that as a starting guess. */
1028 *pbuf = gfc_getmem (buflen + 1);
1034 preprocessor_flag = 0;
1037 /* In order to not truncate preprocessor lines, we have to
1038 remember that this is one. */
1039 preprocessor_flag = 1;
1050 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1051 if (gfc_current_form == FORM_FREE
1052 && !seen_printable && seen_ampersand)
1055 gfc_error_now ("'&' not allowed by itself in line %d",
1058 gfc_warning_now ("'&' not allowed by itself in line %d",
1065 continue; /* Gobble characters. */
1077 if ((c != '&' && c != '!') || (c == '!' && !seen_ampersand))
1080 /* Is this a fixed-form comment? */
1081 if (gfc_current_form == FORM_FIXED && i == 0
1082 && (c == '*' || c == 'c' || c == 'd'))
1085 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
1087 if (!gfc_option.warn_tabs && seen_comment == 0
1088 && current_line != linenum)
1090 linenum = current_line;
1091 gfc_warning_now ("Nonconforming tab character in column 1 "
1092 "of line %d", linenum);
1107 if (maxlen == 0 || preprocessor_flag)
1111 /* Reallocate line buffer to double size to hold the
1113 buflen = buflen * 2;
1114 *pbuf = xrealloc (*pbuf, buflen + 1);
1115 buffer = (*pbuf) + i;
1118 else if (i >= maxlen)
1120 /* Truncate the rest of the line. */
1124 if (c == '\n' || c == EOF)
1130 ungetc ('\n', input);
1134 /* Pad lines to the selected line length in fixed form. */
1135 if (gfc_current_form == FORM_FIXED
1136 && gfc_option.fixed_line_length != 0
1137 && !preprocessor_flag
1140 while (i++ < maxlen)
1152 /* Get a gfc_file structure, initialize it and add it to
1156 get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
1160 f = gfc_getmem (sizeof (gfc_file));
1162 f->filename = gfc_getmem (strlen (name) + 1);
1163 strcpy (f->filename, name);
1165 f->next = file_head;
1168 f->included_by = current_file;
1169 if (current_file != NULL)
1170 f->inclusion_line = current_file->line;
1172 #ifdef USE_MAPPED_LOCATION
1173 linemap_add (line_table, reason, false, f->filename, 1);
1179 /* Deal with a line from the C preprocessor. The
1180 initial octothorp has already been seen. */
1183 preprocessor_line (char *c)
1189 int escaped, unescape;
1192 while (*c == ' ' || *c == '\t')
1195 if (*c < '0' || *c > '9')
1200 c = strchr (c, ' ');
1203 /* No file name given. Set new line number. */
1204 current_file->line = line;
1209 while (*c == ' ' || *c == '\t')
1219 /* Make filename end at quote. */
1222 while (*c && ! (!escaped && *c == '"'))
1226 else if (*c == '\\')
1235 /* Preprocessor line has no closing quote. */
1240 /* Undo effects of cpp_quote_string. */
1244 char *d = gfc_getmem (c - filename - unescape);
1260 flag[1] = flag[2] = flag[3] = flag[4] = false;
1264 c = strchr (c, ' ');
1271 if (1 <= i && i <= 4)
1275 /* Interpret flags. */
1277 if (flag[1]) /* Starting new file. */
1279 f = get_file (filename, LC_RENAME);
1280 f->up = current_file;
1284 if (flag[2]) /* Ending current file. */
1286 if (!current_file->up
1287 || strcmp (current_file->up->filename, filename) != 0)
1289 gfc_warning_now ("%s:%d: file %s left but not entered",
1290 current_file->filename, current_file->line,
1293 gfc_free (filename);
1296 current_file = current_file->up;
1299 /* The name of the file can be a temporary file produced by
1300 cpp. Replace the name if it is different. */
1302 if (strcmp (current_file->filename, filename) != 0)
1304 gfc_free (current_file->filename);
1305 current_file->filename = gfc_getmem (strlen (filename) + 1);
1306 strcpy (current_file->filename, filename);
1309 /* Set new line number. */
1310 current_file->line = line;
1312 gfc_free (filename);
1316 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
1317 current_file->filename, current_file->line);
1318 current_file->line++;
1322 static try load_file (const char *, bool);
1324 /* include_line()-- Checks a line buffer to see if it is an include
1325 line. If so, we call load_file() recursively to load the included
1326 file. We never return a syntax error because a statement like
1327 "include = 5" is perfectly legal. We return false if no include was
1328 processed or true if we matched an include. */
1331 include_line (char *line)
1333 char quote, *c, *begin, *stop;
1337 if (gfc_option.flag_openmp)
1339 if (gfc_current_form == FORM_FREE)
1341 while (*c == ' ' || *c == '\t')
1343 if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1348 if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
1349 && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1354 while (*c == ' ' || *c == '\t')
1357 if (strncasecmp (c, "include", 7))
1361 while (*c == ' ' || *c == '\t')
1364 /* Find filename between quotes. */
1367 if (quote != '"' && quote != '\'')
1372 while (*c != quote && *c != '\0')
1380 while (*c == ' ' || *c == '\t')
1383 if (*c != '\0' && *c != '!')
1386 /* We have an include line at this point. */
1388 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
1389 read by anything else. */
1391 load_file (begin, false);
1396 /* Load a file into memory by calling load_line until the file ends. */
1399 load_file (const char *filename, bool initial)
1408 for (f = current_file; f; f = f->up)
1409 if (strcmp (filename, f->filename) == 0)
1411 gfc_error_now ("File '%s' is being included recursively", filename);
1419 input = gfc_src_file;
1420 gfc_src_file = NULL;
1423 input = gfc_open_file (filename);
1426 gfc_error_now ("Can't open file '%s'", filename);
1432 input = gfc_open_included_file (filename, false, false);
1435 gfc_error_now ("Can't open included file '%s'", filename);
1440 /* Load the file. */
1442 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1443 f->up = current_file;
1445 current_file->line = 1;
1450 if (initial && gfc_src_preprocessor_lines[0])
1452 preprocessor_line (gfc_src_preprocessor_lines[0]);
1453 gfc_free (gfc_src_preprocessor_lines[0]);
1454 gfc_src_preprocessor_lines[0] = NULL;
1455 if (gfc_src_preprocessor_lines[1])
1457 preprocessor_line (gfc_src_preprocessor_lines[1]);
1458 gfc_free (gfc_src_preprocessor_lines[1]);
1459 gfc_src_preprocessor_lines[1] = NULL;
1465 int trunc = load_line (input, &line, &line_len);
1467 len = strlen (line);
1468 if (feof (input) && len == 0)
1471 /* If this is the first line of the file, it can contain a byte
1472 order mark (BOM), which we will ignore:
1473 FF FE is UTF-16 little endian,
1474 FE FF is UTF-16 big endian,
1475 EF BB BF is UTF-8. */
1477 && ((line_len >= 2 && line[0] == '\xFF' && line[1] == '\xFE')
1478 || (line_len >= 2 && line[0] == '\xFE' && line[1] == '\xFF')
1479 || (line_len >= 3 && line[0] == '\xEF' && line[1] == '\xBB'
1480 && line[2] == '\xBF')))
1482 int n = line[1] == '\xBB' ? 3 : 2;
1483 char * new = gfc_getmem (line_len);
1485 strcpy (new, line + n);
1491 /* There are three things this line can be: a line of Fortran
1492 source, an include line or a C preprocessor directive. */
1496 preprocessor_line (line);
1500 /* Preprocessed files have preprocessor lines added before the byte
1501 order mark, so first_line is not about the first line of the file
1502 but the first line that's not a preprocessor line. */
1505 if (include_line (line))
1507 current_file->line++;
1513 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1515 #ifdef USE_MAPPED_LOCATION
1517 = linemap_line_start (line_table, current_file->line++, 120);
1519 b->linenum = current_file->line++;
1521 b->file = current_file;
1522 b->truncated = trunc;
1523 strcpy (b->line, line);
1525 if (line_head == NULL)
1528 line_tail->next = b;
1533 /* Release the line buffer allocated in load_line. */
1538 current_file = current_file->up;
1539 #ifdef USE_MAPPED_LOCATION
1540 linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
1546 /* Open a new file and start scanning from that file. Returns SUCCESS
1547 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1548 it tries to determine the source form from the filename, defaulting
1556 result = load_file (gfc_source_file, true);
1558 gfc_current_locus.lb = line_head;
1559 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1561 #if 0 /* Debugging aid. */
1562 for (; line_head; line_head = line_head->next)
1563 gfc_status ("%s:%3d %s\n", line_head->file->filename,
1564 #ifdef USE_MAPPED_LOCATION
1565 LOCATION_LINE (line_head->location),
1578 unescape_filename (const char *ptr)
1580 const char *p = ptr, *s;
1582 int escaped, unescape = 0;
1584 /* Make filename end at quote. */
1586 while (*p && ! (! escaped && *p == '"'))
1590 else if (*p == '\\')
1601 /* Undo effects of cpp_quote_string. */
1603 d = gfc_getmem (p + 1 - ptr - unescape);
1618 /* For preprocessed files, if the first tokens are of the form # NUM.
1619 handle the directives so we know the original file name. */
1622 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
1627 gfc_src_file = gfc_open_file (filename);
1628 if (gfc_src_file == NULL)
1631 c = getc (gfc_src_file);
1632 ungetc (c, gfc_src_file);
1638 load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
1640 if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
1643 filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
1644 if (filename == NULL)
1647 c = getc (gfc_src_file);
1648 ungetc (c, gfc_src_file);
1654 load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
1656 if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
1659 dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
1660 if (dirname == NULL)
1663 len = strlen (dirname);
1664 if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
1669 dirname[len - 2] = '\0';
1670 set_src_pwd (dirname);
1672 if (! IS_ABSOLUTE_PATH (filename))
1674 char *p = gfc_getmem (len + strlen (filename));
1676 memcpy (p, dirname, len - 2);
1678 strcpy (p + len - 1, filename);
1679 *canon_source_file = p;