/* Character scanner.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
Contributed by Andy Vaught
#include "system.h"
#include "gfortran.h"
#include "toplev.h"
+#include "debug.h"
+#include "flags.h"
/* Structure for holding module and include file search path. */
typedef struct gfc_directorylist
locus gfc_current_locus;
const char *gfc_source_file;
static FILE *gfc_src_file;
-static char *gfc_src_preprocessor_lines[2];
+static gfc_char_t *gfc_src_preprocessor_lines[2];
extern int pedantic;
+static struct gfc_file_change
+{
+ const char *filename;
+ gfc_linebuf *lb;
+ int line;
+} *file_changes;
+size_t file_changes_cur, file_changes_count;
+size_t file_changes_allocated;
+
+
+/* Functions dealing with our wide characters (gfc_char_t) and
+ sequences of such characters. */
+
+int
+gfc_wide_fits_in_byte (gfc_char_t c)
+{
+ return (c <= UCHAR_MAX);
+}
+
+static inline int
+wide_is_ascii (gfc_char_t c)
+{
+ return (gfc_wide_fits_in_byte (c) && ((unsigned char) c & ~0x7f) == 0);
+}
+
+int
+gfc_wide_is_printable (gfc_char_t c)
+{
+ return (gfc_wide_fits_in_byte (c) && ISPRINT ((unsigned char) c));
+}
+
+gfc_char_t
+gfc_wide_tolower (gfc_char_t c)
+{
+ return (wide_is_ascii (c) ? (gfc_char_t) TOLOWER((unsigned char) c) : c);
+}
+
+int
+gfc_wide_is_digit (gfc_char_t c)
+{
+ return (c >= '0' && c <= '9');
+}
+
+static inline int
+wide_atoi (gfc_char_t *c)
+{
+#define MAX_DIGITS 20
+ char buf[MAX_DIGITS+1];
+ int i = 0;
+
+ while (gfc_wide_is_digit(*c) && i < MAX_DIGITS)
+ buf[i++] = *c++;
+ buf[i] = '\0';
+ return atoi (buf);
+}
+
+size_t
+gfc_wide_strlen (const gfc_char_t *str)
+{
+ size_t i;
+
+ for (i = 0; str[i]; i++)
+ ;
+
+ return i;
+}
+
+static gfc_char_t *
+wide_strcpy (gfc_char_t *dest, const gfc_char_t *src)
+{
+ gfc_char_t *d;
+
+ for (d = dest; (*d = *src) != '\0'; ++src, ++d)
+ ;
+
+ return dest;
+}
+
+static gfc_char_t *
+wide_strchr (gfc_char_t *s, gfc_char_t c)
+{
+ do {
+ if (*s == c)
+ {
+ return (gfc_char_t *) s;
+ }
+ } while (*s++);
+ return 0;
+}
+
+static char *
+widechar_to_char (gfc_char_t *s)
+{
+ size_t len = gfc_wide_strlen (s), i;
+ char *res = gfc_getmem (len + 1);
+
+ for (i = 0; i < len; i++)
+ res[i] = gfc_wide_fits_in_byte (s[i]) ? (unsigned char) s[i] : '?';
+
+ res[len] = '\0';
+ return res;
+}
+
+static int
+wide_strncmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+ gfc_char_t c1, c2;
+
+ while (n-- > 0)
+ {
+ c1 = *s1++;
+ c2 = *s2++;
+ if (c1 != c2)
+ return (c1 > c2 ? 1 : -1);
+ if (c1 == '\0')
+ return 0;
+ }
+ return 0;
+}
+
+static int
+wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+ gfc_char_t c1, c2;
+
+ while (n-- > 0)
+ {
+ c1 = gfc_wide_tolower (*s1++);
+ c2 = TOLOWER (*s2++);
+ if (c1 != c2)
+ return (c1 > c2 ? 1 : -1);
+ if (c1 == '\0')
+ return 0;
+ }
+ return 0;
+}
+
+
/* Main scanner initialization. */
void
return (*gfc_current_locus.nextc == '\0');
}
+static void
+add_file_change (const char *filename, int line)
+{
+ if (file_changes_count == file_changes_allocated)
+ {
+ if (file_changes_allocated)
+ file_changes_allocated *= 2;
+ else
+ file_changes_allocated = 16;
+ file_changes
+ = xrealloc (file_changes,
+ file_changes_allocated * sizeof (*file_changes));
+ }
+ file_changes[file_changes_count].filename = filename;
+ file_changes[file_changes_count].lb = NULL;
+ file_changes[file_changes_count++].line = line;
+}
+
+static void
+report_file_change (gfc_linebuf *lb)
+{
+ size_t c = file_changes_cur;
+ while (c < file_changes_count
+ && file_changes[c].lb == lb)
+ {
+ if (file_changes[c].filename)
+ (*debug_hooks->start_source_file) (file_changes[c].line,
+ file_changes[c].filename);
+ else
+ (*debug_hooks->end_source_file) (file_changes[c].line);
+ ++c;
+ }
+ file_changes_cur = c;
+}
+
+void
+gfc_start_source_files (void)
+{
+ /* If the debugger wants the name of the main source file,
+ we give it. */
+ if (debug_hooks->start_end_main_source_file)
+ (*debug_hooks->start_source_file) (0, gfc_source_file);
+
+ file_changes_cur = 0;
+ report_file_change (gfc_current_locus.lb);
+}
+
+void
+gfc_end_source_files (void)
+{
+ report_file_change (NULL);
+
+ if (debug_hooks->start_end_main_source_file)
+ (*debug_hooks->end_source_file) (0);
+}
/* Advance the current line pointer to the next line. */
return;
}
+ if (gfc_current_locus.lb->next
+ && !gfc_current_locus.lb->next->dbg_emitted)
+ {
+ report_file_change (gfc_current_locus.lb->next);
+ gfc_current_locus.lb->next->dbg_emitted = true;
+ }
+
gfc_current_locus.lb = gfc_current_locus.lb->next;
if (gfc_current_locus.lb != NULL)
pointer from being on the wrong line if the current statement ends
prematurely. */
-static int
+static gfc_char_t
next_char (void)
{
- int c;
+ gfc_char_t c;
if (gfc_current_locus.nextc == NULL)
return '\n';
- c = (unsigned char) *gfc_current_locus.nextc++;
+ c = *gfc_current_locus.nextc++;
if (c == '\0')
{
gfc_current_locus.nextc--; /* Remain on this line. */
static void
skip_comment_line (void)
{
- char c;
+ gfc_char_t c;
do
{
}
+int
+gfc_define_undef_line (void)
+{
+ char *tmp;
+
+ /* All lines beginning with '#' are either #define or #undef. */
+ if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_ascii_char () != '#')
+ return 0;
+
+ if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
+ {
+ tmp = widechar_to_char (&gfc_current_locus.nextc[8]);
+ (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
+ tmp);
+ gfc_free (tmp);
+ }
+
+ if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
+ {
+ tmp = widechar_to_char (&gfc_current_locus.nextc[7]);
+ (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
+ tmp);
+ gfc_free (tmp);
+ }
+
+ /* Skip the rest of the line. */
+ skip_comment_line ();
+
+ return 1;
+}
+
+
/* Comment lines are null lines, lines containing only blanks or lines
on which the first nonblank line is a '!'.
Return true if !$ openmp conditional compilation sentinel was
skip_free_comments (void)
{
locus start;
- char c;
+ gfc_char_t c;
int at_bol;
for (;;)
{
locus start;
int col;
- char c;
+ gfc_char_t c;
if (! gfc_at_bol ())
{
!$|c$|*$ should be treated as 2 spaces if the characters
in columns 3 to 6 are valid fixed form label columns
characters. */
+ if (gfc_current_locus.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+
if (gfc_option.flag_openmp)
{
if (next_char () == '$')
if (col != 6 && c == '!')
{
+ if (gfc_current_locus.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
skip_comment_line ();
continue;
}
line. The in_string flag denotes whether we're inside a character
context or not. */
-int
+gfc_char_t
gfc_next_char_literal (int in_string)
{
locus old_loc;
- int i, c, prev_openmp_flag;
+ int i, prev_openmp_flag;
+ gfc_char_t c;
continue_flag = 0;
"statement at %C", gfc_option.max_continue_free);
}
}
- continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
/* Now find where it continues. First eat any comment lines. */
openmp_cond_flag = skip_free_comments ();
+ if (gfc_current_locus.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+
if (prev_openmp_flag != openmp_flag)
{
gfc_current_locus = old_loc;
{
for (i = 0; i < 5; i++, c = next_char ())
{
- gcc_assert (TOLOWER (c) == "!$omp"[i]);
+ gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$omp"[i]);
if (i == 4)
old_loc = gfc_current_locus;
}
for (i = 0; i < 5; i++)
{
c = next_char ();
- if (TOLOWER (c) != "*$omp"[i])
+ if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
goto not_continuation;
}
}
}
- if (continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+ if (gfc_current_locus.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
}
parsing character literals, they have to call
gfc_next_char_literal(). */
-int
+gfc_char_t
gfc_next_char (void)
{
- int c;
+ gfc_char_t c;
do
{
}
while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
- return TOLOWER (c);
+ return gfc_wide_tolower (c);
}
+char
+gfc_next_ascii_char (void)
+{
+ gfc_char_t c = gfc_next_char ();
-int
+ return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+ : (unsigned char) UCHAR_MAX);
+}
+
+
+gfc_char_t
gfc_peek_char (void)
{
locus old_loc;
- int c;
+ gfc_char_t c;
old_loc = gfc_current_locus;
c = gfc_next_char ();
}
+char
+gfc_peek_ascii_char (void)
+{
+ gfc_char_t c = gfc_peek_char ();
+
+ return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+ : (unsigned char) UCHAR_MAX);
+}
+
+
/* Recover from an error. We try to get past the current statement
and get lined up for the next. The next statement follows a '\n'
or a ';'. We also assume that we are not within a character
void
gfc_error_recovery (void)
{
- char c, delim;
+ gfc_char_t c, delim;
if (gfc_at_eof ())
return;
{
static int linenum = 0;
locus old_loc;
- int c;
+ gfc_char_t c;
do
{
line will be scanned multiple times. */
if (!gfc_option.warn_tabs && c == '\t')
{
-#ifdef USE_MAPPED_LOCATION
int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
-#else
- int cur_linenum = gfc_current_locus.lb->linenum;
-#endif
if (cur_linenum != linenum)
{
linenum = cur_linenum;
parts of gfortran. */
static int
-load_line (FILE *input, char **pbuf, int *pbuflen)
+load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
{
static int linenum = 0, current_line = 1;
int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
int trunc_flag = 0, seen_comment = 0;
int seen_printable = 0, seen_ampersand = 0;
- char *buffer;
+ gfc_char_t *buffer;
+ bool found_tab = false;
/* Determine the maximum allowed line length. */
if (gfc_current_form == FORM_FREE)
else
buflen = 132;
- *pbuf = gfc_getmem (buflen + 1);
+ *pbuf = gfc_getmem ((buflen + 1) * sizeof (gfc_char_t));
}
i = 0;
seen_ampersand = 1;
}
- if ((c != '&' && c != '!') || (c == '!' && !seen_ampersand))
+ if ((c != '&' && c != '!' && c != ' ') || (c == '!' && !seen_ampersand))
seen_printable = 1;
/* Is this a fixed-form comment? */
&& (c == '*' || c == 'c' || c == 'd'))
seen_comment = 1;
- if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
+ /* Vendor extension: "<tab>1" marks a continuation line. */
+ if (found_tab)
{
+ found_tab = false;
+ if (c >= '1' && c <= '9')
+ {
+ *(buffer-1) = c;
+ continue;
+ }
+ }
+
+ if (gfc_current_form == FORM_FIXED && c == '\t' && i < 6)
+ {
+ found_tab = true;
+
if (!gfc_option.warn_tabs && seen_comment == 0
&& current_line != linenum)
{
linenum = current_line;
- gfc_warning_now ("Nonconforming tab character in column 1 "
- "of line %d", linenum);
+ gfc_warning_now ("Nonconforming tab character in column %d "
+ "of line %d", i+1, linenum);
}
- while (i <= 6)
+ while (i < 6)
{
*buffer++ = ' ';
i++;
/* Reallocate line buffer to double size to hold the
overlong line. */
buflen = buflen * 2;
- *pbuf = xrealloc (*pbuf, buflen + 1);
+ *pbuf = xrealloc (*pbuf, (buflen + 1) * sizeof (gfc_char_t));
buffer = (*pbuf) + i;
}
}
f->next = file_head;
file_head = f;
- f->included_by = current_file;
+ f->up = current_file;
if (current_file != NULL)
f->inclusion_line = current_file->line;
-#ifdef USE_MAPPED_LOCATION
linemap_add (line_table, reason, false, f->filename, 1);
-#endif
return f;
}
+
/* Deal with a line from the C preprocessor. The
initial octothorp has already been seen. */
static void
-preprocessor_line (char *c)
+preprocessor_line (gfc_char_t *c)
{
bool flag[5];
int i, line;
- char *filename;
+ gfc_char_t *wide_filename;
gfc_file *f;
int escaped, unescape;
+ char *filename;
c++;
while (*c == ' ' || *c == '\t')
if (*c < '0' || *c > '9')
goto bad_cpp_line;
- line = atoi (c);
+ line = wide_atoi (c);
- c = strchr (c, ' ');
+ c = wide_strchr (c, ' ');
if (c == NULL)
{
/* No file name given. Set new line number. */
goto bad_cpp_line;
++c;
- filename = c;
+ wide_filename = c;
/* Make filename end at quote. */
unescape = 0;
/* Undo effects of cpp_quote_string. */
if (unescape)
{
- char *s = filename;
- char *d = gfc_getmem (c - filename - unescape);
+ gfc_char_t *s = wide_filename;
+ gfc_char_t *d = gfc_getmem (c - wide_filename - unescape);
- filename = d;
+ wide_filename = d;
while (*s)
{
if (*s == '\\')
for (;;)
{
- c = strchr (c, ' ');
+ c = wide_strchr (c, ' ');
if (c == NULL)
break;
c++;
- i = atoi (c);
+ i = wide_atoi (c);
if (1 <= i && i <= 4)
flag[i] = true;
}
+ /* Convert the filename in wide characters into a filename in narrow
+ characters. */
+ filename = widechar_to_char (wide_filename);
+
/* Interpret flags. */
if (flag[1]) /* Starting new file. */
{
f = get_file (filename, LC_RENAME);
- f->up = current_file;
+ add_file_change (f->filename, f->inclusion_line);
current_file = f;
}
current_file->filename, current_file->line,
filename);
if (unescape)
- gfc_free (filename);
+ gfc_free (wide_filename);
+ gfc_free (filename);
return;
}
+ add_file_change (NULL, line);
current_file = current_file->up;
-#ifdef USE_MAPPED_LOCATION
linemap_add (line_table, LC_RENAME, false, current_file->filename,
current_file->line);
-#endif
}
/* The name of the file can be a temporary file produced by
/* Set new line number. */
current_file->line = line;
if (unescape)
- gfc_free (filename);
+ gfc_free (wide_filename);
+ gfc_free (filename);
return;
bad_cpp_line:
processed or true if we matched an include. */
static bool
-include_line (char *line)
+include_line (gfc_char_t *line)
{
- char quote, *c, *begin, *stop;
+ gfc_char_t quote, *c, *begin, *stop;
+ char *filename;
c = line;
while (*c == ' ' || *c == '\t')
c++;
- if (strncasecmp (c, "include", 7))
- return false;
+ if (wide_strncasecmp (c, "include", 7))
+ return false;
c += 7;
while (*c == ' ' || *c == '\t')
*stop = '\0'; /* It's ok to trash the buffer, as this line won't be
read by anything else. */
- load_file (begin, false);
+ filename = widechar_to_char (begin);
+ load_file (filename, false);
+ gfc_free (filename);
return true;
}
static try
load_file (const char *filename, bool initial)
{
- char *line;
+ gfc_char_t *line;
gfc_linebuf *b;
gfc_file *f;
FILE *input;
/* Load the file. */
f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
- f->up = current_file;
+ if (!initial)
+ add_file_change (f->filename, f->inclusion_line);
current_file = f;
current_file->line = 1;
line = NULL;
{
int trunc = load_line (input, &line, &line_len);
- len = strlen (line);
+ len = gfc_wide_strlen (line);
if (feof (input) && len == 0)
break;
FE FF is UTF-16 big endian,
EF BB BF is UTF-8. */
if (first_line
- && ((line_len >= 2 && line[0] == '\xFF' && line[1] == '\xFE')
- || (line_len >= 2 && line[0] == '\xFE' && line[1] == '\xFF')
- || (line_len >= 3 && line[0] == '\xEF' && line[1] == '\xBB'
- && line[2] == '\xBF')))
+ && ((line_len >= 2 && line[0] == (unsigned char) '\xFF'
+ && line[1] == (unsigned char) '\xFE')
+ || (line_len >= 2 && line[0] == (unsigned char) '\xFE'
+ && line[1] == (unsigned char) '\xFF')
+ || (line_len >= 3 && line[0] == (unsigned char) '\xEF'
+ && line[1] == (unsigned char) '\xBB'
+ && line[2] == (unsigned char) '\xBF')))
{
- int n = line[1] == '\xBB' ? 3 : 2;
- char * new = gfc_getmem (line_len);
+ int n = line[1] == (unsigned char) '\xBB' ? 3 : 2;
+ gfc_char_t *new = gfc_getmem (line_len * sizeof (gfc_char_t));
- strcpy (new, line + n);
+ wide_strcpy (new, &line[n]);
gfc_free (line);
line = new;
len -= n;
if (line[0] == '#')
{
- preprocessor_line (line);
- continue;
+ /* When -g3 is specified, it's possible that we emit #define
+ and #undef lines, which we need to pass to the middle-end
+ so that it can emit correct debug info. */
+ if (debug_info_level == DINFO_LEVEL_VERBOSE
+ && (wide_strncmp (line, "#define ", 8) == 0
+ || wide_strncmp (line, "#undef ", 7) == 0))
+ ;
+ else
+ {
+ preprocessor_line (line);
+ continue;
+ }
}
/* Preprocessed files have preprocessor lines added before the byte
/* Add line. */
- b = gfc_getmem (gfc_linebuf_header_size + len + 1);
+ b = gfc_getmem (gfc_linebuf_header_size
+ + (len + 1) * sizeof (gfc_char_t));
-#ifdef USE_MAPPED_LOCATION
b->location
= linemap_line_start (line_table, current_file->line++, 120);
-#else
- b->linenum = current_file->line++;
-#endif
b->file = current_file;
b->truncated = trunc;
- strcpy (b->line, line);
+ wide_strcpy (b->line, line);
if (line_head == NULL)
line_head = b;
line_tail->next = b;
line_tail = b;
+
+ while (file_changes_cur < file_changes_count)
+ file_changes[file_changes_cur++].lb = b;
}
/* Release the line buffer allocated in load_line. */
fclose (input);
+ if (!initial)
+ add_file_change (NULL, current_file->inclusion_line + 1);
current_file = current_file->up;
-#ifdef USE_MAPPED_LOCATION
linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
-#endif
return SUCCESS;
}
#if 0 /* Debugging aid. */
for (; line_head; line_head = line_head->next)
- gfc_status ("%s:%3d %s\n",
-#ifdef USE_MAPPED_LOCATION
- LOCATION_FILE (line_head->location),
- LOCATION_LINE (line_head->location),
-#else
- line_head->file->filename,
- line_head->linenum,
-#endif
- line_head->line);
+ printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location),
+ LOCATION_LINE (line_head->location), line_head->line);
exit (0);
#endif
gfc_read_orig_filename (const char *filename, const char **canon_source_file)
{
int c, len;
- char *dirname;
+ char *dirname, *tmp;
gfc_src_file = gfc_open_file (filename);
if (gfc_src_file == NULL)
len = 0;
load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
- if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
+ if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
return NULL;
- filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
+ tmp = widechar_to_char (&gfc_src_preprocessor_lines[0][5]);
+ filename = unescape_filename (tmp);
+ gfc_free (tmp);
if (filename == NULL)
return NULL;
len = 0;
load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
- if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
+ if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
return filename;
- dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
+ tmp = widechar_to_char (&gfc_src_preprocessor_lines[1][5]);
+ dirname = unescape_filename (tmp);
+ gfc_free (tmp);
if (dirname == NULL)
return filename;
OSDN Git Service
