Fortran: Dead-function removal in error.cc (shrinking by 40%)
This patch removes a large number of unused static functions from error.cc,
which previously were used for diagnostic but have been replaced by the common
diagnostic code.
gcc/fortran/ChangeLog:
* error.cc (error_char, error_string, error_uinteger, error_integer,
error_hwuint, error_hwint, gfc_widechar_display_length,
gfc_wide_display_length, error_printf, show_locus, show_loci):
Remove unused static functions.
(IBUF_LEN, MAX_ARGS): Remove now unused #define.
@@ -128,136 +143,6 @@ gfc_buffer_error (bool flag)
}
-/* Add a single character to the error buffer or output depending on
- buffered_p. */
-
-static void
-error_char (char)
-{
- /* FIXME: Unused function to be removed in a subsequent patch. */
-}
-
-
-/* Copy a string to wherever it needs to go. */
-
-static void
-error_string (const char *p)
-{
- while (*p)
- error_char (*p++);
-}
-
-
-/* Print a formatted integer to the error buffer or output. */
-
-#define IBUF_LEN 60
-
-static void
-error_uinteger (unsigned long long int i)
-{
- char *p, int_buf[IBUF_LEN];
-
- p = int_buf + IBUF_LEN - 1;
- *p-- = '\0';
-
- if (i == 0)
- *p-- = '0';
-
- while (i > 0)
- {
- *p-- = i % 10 + '0';
- i = i / 10;
- }
-
- error_string (p + 1);
-}
-
-static void
-error_integer (long long int i)
-{
- unsigned long long int u;
-
- if (i < 0)
- {
- u = (unsigned long long int) -i;
- error_char ('-');
- }
- else
- u = i;
-
- error_uinteger (u);
-}
-
-
-static void
-error_hwuint (unsigned HOST_WIDE_INT i)
-{
- char *p, int_buf[IBUF_LEN];
-
- p = int_buf + IBUF_LEN - 1;
- *p-- = '\0';
-
- if (i == 0)
- *p-- = '0';
-
- while (i > 0)
- {
- *p-- = i % 10 + '0';
- i = i / 10;
- }
-
- error_string (p + 1);
-}
-
-static void
-error_hwint (HOST_WIDE_INT i)
-{
- unsigned HOST_WIDE_INT u;
-
- if (i < 0)
- {
- u = (unsigned HOST_WIDE_INT) -i;
- error_char ('-');
- }
- else
- u = i;
-
- error_uinteger (u);
-}
-
-
-static size_t
-gfc_widechar_display_length (gfc_char_t c)
-{
- if (gfc_wide_is_printable (c) || c == '\t')
- /* Printable ASCII character, or tabulation (output as a space). */
- return 1;
- else if (c < ((gfc_char_t) 1 << 8))
- /* Displayed as \x?? */
- return 4;
- else if (c < ((gfc_char_t) 1 << 16))
- /* Displayed as \u???? */
- return 6;
- else
- /* Displayed as \U???????? */
- return 10;
-}
-
-
-/* Length of the ASCII representation of the wide string, escaping wide
- characters as print_wide_char_into_buffer() does. */
-
-static size_t
-gfc_wide_display_length (const gfc_char_t *str)
-{
- size_t i, len;
-
- for (i = 0, len = 0; str[i]; i++)
- len += gfc_widechar_display_length (str[i]);
-
- return len;
-}
-
static int
print_wide_char_into_buffer (gfc_char_t c, char *buf)
{
@@ -332,593 +217,6 @@ gfc_print_wide_char (gfc_char_t c)
}
-/* Show the file, where it was included, and the source line, give a
- locus. Calls error_printf() recursively, but the recursion is at
- most one level deep. */
-
-static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
-
-static void
-show_locus (locus *loc, int c1, int c2)
-{
- gfc_linebuf *lb;
- gfc_file *f;
- gfc_char_t *p;
- int i, offset, cmax;
-
- /* TODO: Either limit the total length and number of included files
- displayed or add buffering of arbitrary number of characters in
- error messages. */
-
- /* Write out the error header line, giving the source file and error
- location (in GNU standard "[file]:[line].[column]:" format),
- followed by an "included by" stack and a blank line. This header
- format is matched by a testsuite parser defined in
- lib/gfortran-dg.exp. */
-
- lb = loc->lb;
- f = lb->file;
-
- error_string (f->filename);
- error_char (':');
-
- error_integer (LOCATION_LINE (lb->location));
-
- if ((c1 > 0) || (c2 > 0))
- error_char ('.');
-
- if (c1 > 0)
- error_integer (c1);
-
- if ((c1 > 0) && (c2 > 0))
- error_char ('-');
-
- if (c2 > 0)
- error_integer (c2);
-
- error_char (':');
- error_char ('\n');
-
- for (;;)
- {
- i = f->inclusion_line;
-
- f = f->up;
- if (f == NULL) break;
-
- error_printf (" Included at %s:%d:", f->filename, i);
- }
-
- error_char ('\n');
-
- /* Calculate an appropriate horizontal offset of the source line in
- order to get the error locus within the visible portion of the
- line. Note that if the margin of 5 here is changed, the
- corresponding margin of 10 in show_loci should be changed. */
-
- offset = 0;
-
- /* If the two loci would appear in the same column, we shift
- '2' one column to the right, so as to print '12' rather than
- just '1'. We do this here so it will be accounted for in the
- margin calculations. */
-
- if (c1 == c2)
- c2 += 1;
-
- cmax = (c1 < c2) ? c2 : c1;
- if (cmax > terminal_width - 5)
- offset = cmax - terminal_width + 5;
-
- /* Show the line itself, taking care not to print more than what can
- show up on the terminal. Tabs are converted to spaces, and
- nonprintable characters are converted to a "\xNN" sequence. */
-
- p = &(lb->line[offset]);
- i = gfc_wide_display_length (p);
- if (i > terminal_width)
- i = terminal_width - 1;
-
- while (i > 0)
- {
- static char buffer[11];
- i -= print_wide_char_into_buffer (*p++, buffer);
- error_string (buffer);
- }
-
- error_char ('\n');
-
- /* Show the '1' and/or '2' corresponding to the column of the error
- locus. Note that a value of -1 for c1 or c2 will simply cause
- the relevant number not to be printed. */
-
- c1 -= offset;
- c2 -= offset;
- cmax -= offset;
-
- p = &(lb->line[offset]);
- for (i = 0; i < cmax; i++)
- {
- int spaces, j;
- spaces = gfc_widechar_display_length (*p++);
-
- if (i == c1)
- error_char ('1'), spaces--;
- else if (i == c2)
- error_char ('2'), spaces--;
-
- for (j = 0; j < spaces; j++)
- error_char (' ');
- }
-
- if (i == c1)
- error_char ('1');
- else if (i == c2)
- error_char ('2');
-
- error_char ('\n');
-
-}
-
-
-/* As part of printing an error, we show the source lines that caused
- the problem. We show at least one, and possibly two loci; the two
- loci may or may not be on the same source line. */
-
-static void
-show_loci (locus *l1, locus *l2)
-{
- int m, c1, c2;
-
- if (l1 == NULL || l1->lb == NULL)
- {
- error_printf ("<During initialization>\n");
- return;
- }
-
- /* While calculating parameters for printing the loci, we consider possible
- reasons for printing one per line. If appropriate, print the loci
- individually; otherwise we print them both on the same line. */
-
- c1 = l1->nextc - l1->lb->line;
- if (l2 == NULL)
- {
- show_locus (l1, c1, -1);
- return;
- }
-
- c2 = l2->nextc - l2->lb->line;
-
- if (c1 < c2)
- m = c2 - c1;
- else
- m = c1 - c2;
-
- /* Note that the margin value of 10 here needs to be less than the
- margin of 5 used in the calculation of offset in show_locus. */
-
- if (l1->lb != l2->lb || m > terminal_width - 10)
- {
- show_locus (l1, c1, -1);
- show_locus (l2, -1, c2);
- return;
- }
-
- show_locus (l1, c1, c2);
-
- return;
-}
-
-
-/* Workhorse for the error printing subroutines. This subroutine is
- inspired by g77's error handling and is similar to printf() with
- the following %-codes:
-
- %c Character, %d or %i Integer, %s String, %% Percent
- %L Takes locus argument
- %C Current locus (no argument)
-
- If a locus pointer is given, the actual source line is printed out
- and the column is indicated. Since we want the error message at
- the bottom of any source file information, we must scan the
- argument list twice -- once to determine whether the loci are
- present and record this for printing, and once to print the error
- message after and loci have been printed. A maximum of two locus
- arguments are permitted.
-
- This function is also called (recursively) by show_locus in the
- case of included files; however, as show_locus does not resupply
- any loci, the recursion is at most one level deep. */
-
-#define MAX_ARGS 10
-
-static void ATTRIBUTE_GCC_GFC(2,0)
-error_print (const char *type, const char *format0, va_list argp)
-{
- enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
- TYPE_LONGINT, TYPE_ULONGINT, TYPE_LLONGINT, TYPE_ULLONGINT,
- TYPE_HWINT, TYPE_HWUINT, TYPE_CHAR, TYPE_STRING, TYPE_SIZE,
- TYPE_SSIZE, TYPE_PTRDIFF, NOTYPE };
- struct
- {
- int type;
- int pos;
- union
- {
- int intval;
- unsigned int uintval;
- long int longintval;
- unsigned long int ulongintval;
- long long int llongintval;
- unsigned long long int ullongintval;
- HOST_WIDE_INT hwintval;
- unsigned HOST_WIDE_INT hwuintval;
- char charval;
- const char * stringval;
- size_t sizeval;
- ssize_t ssizeval;
- ptrdiff_t ptrdiffval;
- } u;
- } arg[MAX_ARGS], spec[MAX_ARGS];
- /* spec is the array of specifiers, in the same order as they
- appear in the format string. arg is the array of arguments,
- in the same order as they appear in the va_list. */
-
- char c;
- int i, n, have_l1, pos, maxpos;
- locus *l1, *l2, *loc;
- const char *format;
-
- loc = l1 = l2 = NULL;
-
- have_l1 = 0;
- pos = -1;
- maxpos = -1;
-
- n = 0;
- format = format0;
-
- for (i = 0; i < MAX_ARGS; i++)
- {
- arg[i].type = NOTYPE;
- spec[i].pos = -1;
- }
-
- /* First parse the format string for position specifiers. */
- while (*format)
- {
- c = *format++;
- if (c != '%')
- continue;
-
- if (*format == '%')
- {
- format++;
- continue;
- }
-
- if (ISDIGIT (*format))
- {
- /* This is a position specifier. For example, the number
- 12 in the format string "%12$d", which specifies the third
- argument of the va_list, formatted in %d format.
- For details, see "man 3 printf". */
- pos = atoi(format) - 1;
- gcc_assert (pos >= 0);
- while (ISDIGIT(*format))
- format++;
- gcc_assert (*format == '$');
- format++;
- }
- else
- pos++;
-
- c = *format++;
-
- if (pos > maxpos)
- maxpos = pos;
-
- switch (c)
- {
- case 'C':
- arg[pos].type = TYPE_CURRENTLOC;
- break;
-
- case 'L':
- arg[pos].type = TYPE_LOCUS;
- break;
-
- case 'd':
- case 'i':
- arg[pos].type = TYPE_INTEGER;
- break;
-
- case 'u':
- arg[pos].type = TYPE_UINTEGER;
- break;
-
- case 'l':
- c = *format++;
- if (c == 'l')
- {
- c = *format++;
- if (c == 'u')
- arg[pos].type = TYPE_ULLONGINT;
- else if (c == 'i' || c == 'd')
- arg[pos].type = TYPE_LLONGINT;
- else
- gcc_unreachable ();
- }
- else if (c == 'u')
- arg[pos].type = TYPE_ULONGINT;
- else if (c == 'i' || c == 'd')
- arg[pos].type = TYPE_LONGINT;
- else
- gcc_unreachable ();
- break;
-
- case 'w':
- c = *format++;
- if (c == 'u')
- arg[pos].type = TYPE_HWUINT;
- else if (c == 'i' || c == 'd')
- arg[pos].type = TYPE_HWINT;
- else
- gcc_unreachable ();
- break;
-
- case 'z':
- c = *format++;
- if (c == 'u')
- arg[pos].type = TYPE_SIZE;
- else if (c == 'i' || c == 'd')
- arg[pos].type = TYPE_SSIZE;
- else
- gcc_unreachable ();
- break;
-
- case 't':
- c = *format++;
- if (c == 'u' || c == 'i' || c == 'd')
- arg[pos].type = TYPE_PTRDIFF;
- else
- gcc_unreachable ();
- break;
-
- case 'c':
- arg[pos].type = TYPE_CHAR;
- break;
-
- case 's':
- arg[pos].type = TYPE_STRING;
- break;
-
- default:
- gcc_unreachable ();
- }
-
- spec[n++].pos = pos;
- }
-
- /* Then convert the values for each %-style argument. */
- for (pos = 0; pos <= maxpos; pos++)
- {
- gcc_assert (arg[pos].type != NOTYPE);
- switch (arg[pos].type)
- {
- case TYPE_CURRENTLOC:
- loc = &gfc_current_locus;
- /* Fall through. */
-
- case TYPE_LOCUS:
- if (arg[pos].type == TYPE_LOCUS)
- loc = va_arg (argp, locus *);
-
- if (have_l1)
- {
- l2 = loc;
- arg[pos].u.stringval = "(2)";
- /* Point %C first offending character not the last good one. */
- if (arg[pos].type == TYPE_CURRENTLOC && *l2->nextc != '\0')
- l2->nextc++;
- }
- else
- {
- l1 = loc;
- have_l1 = 1;
- arg[pos].u.stringval = "(1)";
- /* Point %C first offending character not the last good one. */
- if (arg[pos].type == TYPE_CURRENTLOC && *l1->nextc != '\0')
- l1->nextc++;
- }
- break;
-
- case TYPE_INTEGER:
- arg[pos].u.intval = va_arg (argp, int);
- break;
-
- case TYPE_UINTEGER:
- arg[pos].u.uintval = va_arg (argp, unsigned int);
- break;
-
- case TYPE_LONGINT:
- arg[pos].u.longintval = va_arg (argp, long int);
- break;
-
- case TYPE_ULONGINT:
- arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
- break;
-
- case TYPE_LLONGINT:
- arg[pos].u.llongintval = va_arg (argp, long long int);
- break;
-
- case TYPE_ULLONGINT:
- arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
- break;
-
- case TYPE_HWINT:
- arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
- break;
-
- case TYPE_HWUINT:
- arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
- break;
-
- case TYPE_SSIZE:
- arg[pos].u.ssizeval = va_arg (argp, ssize_t);
- break;
-
- case TYPE_SIZE:
- arg[pos].u.sizeval = va_arg (argp, size_t);
- break;
-
- case TYPE_PTRDIFF:
- arg[pos].u.ptrdiffval = va_arg (argp, ptrdiff_t);
- break;
-
- case TYPE_CHAR:
- arg[pos].u.charval = (char) va_arg (argp, int);
- break;
-
- case TYPE_STRING:
- arg[pos].u.stringval = (const char *) va_arg (argp, char *);
- break;
-
- default:
- gcc_unreachable ();
- }
- }
-
- for (n = 0; spec[n].pos >= 0; n++)
- spec[n].u = arg[spec[n].pos].u;
-
- /* Show the current loci if we have to. */
- if (have_l1)
- show_loci (l1, l2);
-
- if (*type)
- {
- error_string (type);
- error_char (' ');
- }
-
- have_l1 = 0;
- format = format0;
- n = 0;
-
- for (; *format; format++)
- {
- if (*format != '%')
- {
- error_char (*format);
- continue;
- }
-
- format++;
- if (ISDIGIT (*format))
- {
- /* This is a position specifier. See comment above. */
- while (ISDIGIT (*format))
- format++;
-
- /* Skip over the dollar sign. */
- format++;
- }
-
- switch (*format)
- {
- case '%':
- error_char ('%');
- break;
-
- case 'c':
- error_char (spec[n++].u.charval);
- break;
-
- case 's':
- case 'C': /* Current locus */
- case 'L': /* Specified locus */
- error_string (spec[n++].u.stringval);
- break;
-
- case 'd':
- case 'i':
- error_integer (spec[n++].u.intval);
- break;
-
- case 'u':
- error_uinteger (spec[n++].u.uintval);
- break;
-
- case 'l':
- format++;
- if (*format == 'l')
- {
- format++;
- if (*format == 'u')
- error_uinteger (spec[n++].u.ullongintval);
- else
- error_integer (spec[n++].u.llongintval);
- }
- if (*format == 'u')
- error_uinteger (spec[n++].u.ulongintval);
- else
- error_integer (spec[n++].u.longintval);
- break;
-
- case 'w':
- format++;
- if (*format == 'u')
- error_hwuint (spec[n++].u.hwintval);
- else
- error_hwint (spec[n++].u.hwuintval);
- break;
-
- case 'z':
- format++;
- if (*format == 'u')
- error_uinteger (spec[n++].u.sizeval);
- else
- error_integer (spec[n++].u.ssizeval);
- break;
-
- case 't':
- format++;
- if (*format == 'u')
- {
- unsigned long long a = spec[n++].u.ptrdiffval, m;
-#ifdef PTRDIFF_MAX
- m = PTRDIFF_MAX;
-#else
- m = INTTYPE_MAXIMUM (ptrdiff_t);
-#endif
- m = 2 * m + 1;
- error_uinteger (a & m);
- }
- else
- error_integer (spec[n++].u.ptrdiffval);
- break;
- }
- }
-
- error_char ('\n');
-}
-
-
-/* Wrapper for error_print(). */
-
-static void
-error_printf (const char *gmsgid, ...)
-{
- va_list argp;
-
- va_start (argp, gmsgid);
- error_print ("", _(gmsgid), argp);
- va_end (argp);
-}
-
-
/* Clear any output buffered in a pretty-print output_buffer. */
static void
gcc/fortran/error.cc | 717 ---------------------------------------------------
1 file changed, 717 deletions(-)
@@ -128,136 +128,6 @@ gfc_buffer_error (bool flag)
}
-/* Add a single character to the error buffer or output depending on
- buffered_p. */
-
-static void
-error_char (char)
-{
- /* FIXME: Unused function to be removed in a subsequent patch. */
-}
-
-
-/* Copy a string to wherever it needs to go. */
-
-static void
-error_string (const char *p)
-{
- while (*p)
- error_char (*p++);
-}
-
-
-/* Print a formatted integer to the error buffer or output. */
-
-#define IBUF_LEN 60
-
-static void
-error_uinteger (unsigned long long int i)
-{
- char *p, int_buf[IBUF_LEN];
-
- p = int_buf + IBUF_LEN - 1;
- *p-- = '\0';
-
- if (i == 0)
- *p-- = '0';
-
- while (i > 0)
- {
- *p-- = i % 10 + '0';
- i = i / 10;
- }
-
- error_string (p + 1);
-}
-
-static void
-error_integer (long long int i)
-{
- unsigned long long int u;
-
- if (i < 0)
- {
- u = (unsigned long long int) -i;
- error_char ('-');
- }
- else
- u = i;
-
- error_uinteger (u);
-}
-
-
-static void
-error_hwuint (unsigned HOST_WIDE_INT i)
-{
- char *p, int_buf[IBUF_LEN];
-
- p = int_buf + IBUF_LEN - 1;
- *p-- = '\0';
-
- if (i == 0)
- *p-- = '0';
-
- while (i > 0)
- {
- *p-- = i % 10 + '0';
- i = i / 10;
- }
-
- error_string (p + 1);
-}
-
-static void
-error_hwint (HOST_WIDE_INT i)
-{
- unsigned HOST_WIDE_INT u;
-
- if (i < 0)
- {
- u = (unsigned HOST_WIDE_INT) -i;
- error_char ('-');
- }
- else
- u = i;
-
- error_uinteger (u);
-}
-
-
-static size_t
-gfc_widechar_display_length (gfc_char_t c)
-{
- if (gfc_wide_is_printable (c) || c == '\t')
- /* Printable ASCII character, or tabulation (output as a space). */
- return 1;
- else if (c < ((gfc_char_t) 1 << 8))
- /* Displayed as \x?? */
- return 4;
- else if (c < ((gfc_char_t) 1 << 16))
- /* Displayed as \u???? */
- return 6;
- else
- /* Displayed as \U???????? */
- return 10;
-}
-
-
-/* Length of the ASCII representation of the wide string, escaping wide
- characters as print_wide_char_into_buffer() does. */
-
-static size_t
-gfc_wide_display_length (const gfc_char_t *str)
-{
- size_t i, len;
-
- for (i = 0, len = 0; str[i]; i++)
- len += gfc_widechar_display_length (str[i]);
-
- return len;
-}
-
static int
print_wide_char_into_buffer (gfc_char_t c, char *buf)
{
@@ -332,593 +202,6 @@ gfc_print_wide_char (gfc_char_t c)
}
-/* Show the file, where it was included, and the source line, give a
- locus. Calls error_printf() recursively, but the recursion is at
- most one level deep. */
-
-static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
-
-static void
-show_locus (locus *loc, int c1, int c2)
-{
- gfc_linebuf *lb;
- gfc_file *f;
- gfc_char_t *p;
- int i, offset, cmax;
-
- /* TODO: Either limit the total length and number of included files
- displayed or add buffering of arbitrary number of characters in
- error messages. */
-
- /* Write out the error header line, giving the source file and error
- location (in GNU standard "[file]:[line].[column]:" format),
- followed by an "included by" stack and a blank line. This header
- format is matched by a testsuite parser defined in
- lib/gfortran-dg.exp. */
-
- lb = loc->lb;
- f = lb->file;
-
- error_string (f->filename);
- error_char (':');
-
- error_integer (LOCATION_LINE (lb->location));
-
- if ((c1 > 0) || (c2 > 0))
- error_char ('.');
-
- if (c1 > 0)
- error_integer (c1);
-
- if ((c1 > 0) && (c2 > 0))
- error_char ('-');
-
- if (c2 > 0)
- error_integer (c2);
-
- error_char (':');
- error_char ('\n');
-
- for (;;)
- {
- i = f->inclusion_line;
-
- f = f->up;
- if (f == NULL) break;
-
- error_printf (" Included at %s:%d:", f->filename, i);
- }
-
- error_char ('\n');
-
- /* Calculate an appropriate horizontal offset of the source line in
- order to get the error locus within the visible portion of the
- line. Note that if the margin of 5 here is changed, the
- corresponding margin of 10 in show_loci should be changed. */
-
- offset = 0;
-
- /* If the two loci would appear in the same column, we shift
- '2' one column to the right, so as to print '12' rather than
- just '1'. We do this here so it will be accounted for in the
- margin calculations. */
-
- if (c1 == c2)
- c2 += 1;
-
- cmax = (c1 < c2) ? c2 : c1;
- if (cmax > terminal_width - 5)
- offset = cmax - terminal_width + 5;
-
- /* Show the line itself, taking care not to print more than what can
- show up on the terminal. Tabs are converted to spaces, and
- nonprintable characters are converted to a "\xNN" sequence. */
-
- p = &(lb->line[offset]);
- i = gfc_wide_display_length (p);
- if (i > terminal_width)
- i = terminal_width - 1;
-
- while (i > 0)
- {
- static char buffer[11];
- i -= print_wide_char_into_buffer (*p++, buffer);
- error_string (buffer);
- }
-
- error_char ('\n');
-
- /* Show the '1' and/or '2' corresponding to the column of the error
- locus. Note that a value of -1 for c1 or c2 will simply cause
- the relevant number not to be printed. */
-
- c1 -= offset;
- c2 -= offset;
- cmax -= offset;
-
- p = &(lb->line[offset]);
- for (i = 0; i < cmax; i++)
- {
- int spaces, j;
- spaces = gfc_widechar_display_length (*p++);
-
- if (i == c1)
- error_char ('1'), spaces--;
- else if (i == c2)
- error_char ('2'), spaces--;
-
- for (j = 0; j < spaces; j++)
- error_char (' ');
- }
-
- if (i == c1)
- error_char ('1');
- else if (i == c2)
- error_char ('2');
-
- error_char ('\n');
-
-}
-
-
-/* As part of printing an error, we show the source lines that caused
- the problem. We show at least one, and possibly two loci; the two
- loci may or may not be on the same source line. */
-
-static void
-show_loci (locus *l1, locus *l2)
-{
- int m, c1, c2;
-
- if (l1 == NULL || l1->lb == NULL)
- {
- error_printf ("<During initialization>\n");
- return;
- }
-
- /* While calculating parameters for printing the loci, we consider possible
- reasons for printing one per line. If appropriate, print the loci
- individually; otherwise we print them both on the same line. */
-
- c1 = l1->nextc - l1->lb->line;
- if (l2 == NULL)
- {
- show_locus (l1, c1, -1);
- return;
- }
-
- c2 = l2->nextc - l2->lb->line;
-
- if (c1 < c2)
- m = c2 - c1;
- else
- m = c1 - c2;
-
- /* Note that the margin value of 10 here needs to be less than the
- margin of 5 used in the calculation of offset in show_locus. */
-
- if (l1->lb != l2->lb || m > terminal_width - 10)
- {
- show_locus (l1, c1, -1);
- show_locus (l2, -1, c2);
- return;
- }
-
- show_locus (l1, c1, c2);
-
- return;
-}
-
-
-/* Workhorse for the error printing subroutines. This subroutine is
- inspired by g77's error handling and is similar to printf() with
- the following %-codes:
-
- %c Character, %d or %i Integer, %s String, %% Percent
- %L Takes locus argument
- %C Current locus (no argument)
-
- If a locus pointer is given, the actual source line is printed out
- and the column is indicated. Since we want the error message at
- the bottom of any source file information, we must scan the
- argument list twice -- once to determine whether the loci are
- present and record this for printing, and once to print the error
- message after and loci have been printed. A maximum of two locus
- arguments are permitted.
-
- This function is also called (recursively) by show_locus in the
- case of included files; however, as show_locus does not resupply
- any loci, the recursion is at most one level deep. */
-
-#define MAX_ARGS 10
-
-static void ATTRIBUTE_GCC_GFC(2,0)
-error_print (const char *type, const char *format0, va_list argp)
-{
- enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
- TYPE_LONGINT, TYPE_ULONGINT, TYPE_LLONGINT, TYPE_ULLONGINT,
- TYPE_HWINT, TYPE_HWUINT, TYPE_CHAR, TYPE_STRING, TYPE_SIZE,
- TYPE_SSIZE, TYPE_PTRDIFF, NOTYPE };
- struct
- {
- int type;
- int pos;
- union
- {
- int intval;
- unsigned int uintval;
- long int longintval;
- unsigned long int ulongintval;
- long long int llongintval;
- unsigned long long int ullongintval;
- HOST_WIDE_INT hwintval;
- unsigned HOST_WIDE_INT hwuintval;
- char charval;
- const char * stringval;
- size_t sizeval;
- ssize_t ssizeval;
- ptrdiff_t ptrdiffval;
- } u;
- } arg[MAX_ARGS], spec[MAX_ARGS];
- /* spec is the array of specifiers, in the same order as they
- appear in the format string. arg is the array of arguments,
- in the same order as they appear in the va_list. */
-
- char c;
- int i, n, have_l1, pos, maxpos;
- locus *l1, *l2, *loc;
- const char *format;
-
- loc = l1 = l2 = NULL;
-
- have_l1 = 0;
- pos = -1;
- maxpos = -1;
-
- n = 0;
- format = format0;
-
- for (i = 0; i < MAX_ARGS; i++)
- {
- arg[i].type = NOTYPE;
- spec[i].pos = -1;
- }
-
- /* First parse the format string for position specifiers. */
- while (*format)
- {
- c = *format++;
- if (c != '%')
- continue;
-
- if (*format == '%')
- {
- format++;
- continue;
- }
-
- if (ISDIGIT (*format))
- {
- /* This is a position specifier. For example, the number
- 12 in the format string "%12$d", which specifies the third
- argument of the va_list, formatted in %d format.
- For details, see "man 3 printf". */
- pos = atoi(format) - 1;
- gcc_assert (pos >= 0);
- while (ISDIGIT(*format))
- format++;
- gcc_assert (*format == '$');
- format++;
- }
- else
- pos++;
-
- c = *format++;
-
- if (pos > maxpos)
- maxpos = pos;
-
- switch (c)
- {
- case 'C':
- arg[pos].type = TYPE_CURRENTLOC;
- break;
-
- case 'L':
- arg[pos].type = TYPE_LOCUS;
- break;
-
- case 'd':
- case 'i':
- arg[pos].type = TYPE_INTEGER;
- break;
-
- case 'u':
- arg[pos].type = TYPE_UINTEGER;
- break;
-
- case 'l':
- c = *format++;
- if (c == 'l')
- {
- c = *format++;
- if (c == 'u')
- arg[pos].type = TYPE_ULLONGINT;
- else if (c == 'i' || c == 'd')
- arg[pos].type = TYPE_LLONGINT;
- else
- gcc_unreachable ();
- }
- else if (c == 'u')
- arg[pos].type = TYPE_ULONGINT;
- else if (c == 'i' || c == 'd')
- arg[pos].type = TYPE_LONGINT;
- else
- gcc_unreachable ();
- break;
-
- case 'w':
- c = *format++;
- if (c == 'u')
- arg[pos].type = TYPE_HWUINT;
- else if (c == 'i' || c == 'd')
- arg[pos].type = TYPE_HWINT;
- else
- gcc_unreachable ();
- break;
-
- case 'z':
- c = *format++;
- if (c == 'u')
- arg[pos].type = TYPE_SIZE;
- else if (c == 'i' || c == 'd')
- arg[pos].type = TYPE_SSIZE;
- else
- gcc_unreachable ();
- break;
-
- case 't':
- c = *format++;
- if (c == 'u' || c == 'i' || c == 'd')
- arg[pos].type = TYPE_PTRDIFF;
- else
- gcc_unreachable ();
- break;
-
- case 'c':
- arg[pos].type = TYPE_CHAR;
- break;
-
- case 's':
- arg[pos].type = TYPE_STRING;
- break;
-
- default:
- gcc_unreachable ();
- }
-
- spec[n++].pos = pos;
- }
-
- /* Then convert the values for each %-style argument. */
- for (pos = 0; pos <= maxpos; pos++)
- {
- gcc_assert (arg[pos].type != NOTYPE);
- switch (arg[pos].type)
- {
- case TYPE_CURRENTLOC:
- loc = &gfc_current_locus;
- /* Fall through. */
-
- case TYPE_LOCUS:
- if (arg[pos].type == TYPE_LOCUS)
- loc = va_arg (argp, locus *);
-
- if (have_l1)
- {
- l2 = loc;
- arg[pos].u.stringval = "(2)";
- /* Point %C first offending character not the last good one. */
- if (arg[pos].type == TYPE_CURRENTLOC && *l2->nextc != '\0')
- l2->nextc++;
- }
- else
- {
- l1 = loc;
- have_l1 = 1;
- arg[pos].u.stringval = "(1)";
- /* Point %C first offending character not the last good one. */
- if (arg[pos].type == TYPE_CURRENTLOC && *l1->nextc != '\0')
- l1->nextc++;
- }
- break;
-
- case TYPE_INTEGER:
- arg[pos].u.intval = va_arg (argp, int);
- break;
-
- case TYPE_UINTEGER:
- arg[pos].u.uintval = va_arg (argp, unsigned int);
- break;
-
- case TYPE_LONGINT:
- arg[pos].u.longintval = va_arg (argp, long int);
- break;
-
- case TYPE_ULONGINT:
- arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
- break;
-
- case TYPE_LLONGINT:
- arg[pos].u.llongintval = va_arg (argp, long long int);
- break;
-
- case TYPE_ULLONGINT:
- arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
- break;
-
- case TYPE_HWINT:
- arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
- break;
-
- case TYPE_HWUINT:
- arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
- break;
-
- case TYPE_SSIZE:
- arg[pos].u.ssizeval = va_arg (argp, ssize_t);
- break;
-
- case TYPE_SIZE:
- arg[pos].u.sizeval = va_arg (argp, size_t);
- break;
-
- case TYPE_PTRDIFF:
- arg[pos].u.ptrdiffval = va_arg (argp, ptrdiff_t);
- break;
-
- case TYPE_CHAR:
- arg[pos].u.charval = (char) va_arg (argp, int);
- break;
-
- case TYPE_STRING:
- arg[pos].u.stringval = (const char *) va_arg (argp, char *);
- break;
-
- default:
- gcc_unreachable ();
- }
- }
-
- for (n = 0; spec[n].pos >= 0; n++)
- spec[n].u = arg[spec[n].pos].u;
-
- /* Show the current loci if we have to. */
- if (have_l1)
- show_loci (l1, l2);
-
- if (*type)
- {
- error_string (type);
- error_char (' ');
- }
-
- have_l1 = 0;
- format = format0;
- n = 0;
-
- for (; *format; format++)
- {
- if (*format != '%')
- {
- error_char (*format);
- continue;
- }
-
- format++;
- if (ISDIGIT (*format))
- {
- /* This is a position specifier. See comment above. */
- while (ISDIGIT (*format))
- format++;
-
- /* Skip over the dollar sign. */
- format++;
- }
-
- switch (*format)
- {
- case '%':
- error_char ('%');
- break;
-
- case 'c':
- error_char (spec[n++].u.charval);
- break;
-
- case 's':
- case 'C': /* Current locus */
- case 'L': /* Specified locus */
- error_string (spec[n++].u.stringval);
- break;
-
- case 'd':
- case 'i':
- error_integer (spec[n++].u.intval);
- break;
-
- case 'u':
- error_uinteger (spec[n++].u.uintval);
- break;
-
- case 'l':
- format++;
- if (*format == 'l')
- {
- format++;
- if (*format == 'u')
- error_uinteger (spec[n++].u.ullongintval);
- else
- error_integer (spec[n++].u.llongintval);
- }
- if (*format == 'u')
- error_uinteger (spec[n++].u.ulongintval);
- else
- error_integer (spec[n++].u.longintval);
- break;
-
- case 'w':
- format++;
- if (*format == 'u')
- error_hwuint (spec[n++].u.hwintval);
- else
- error_hwint (spec[n++].u.hwuintval);
- break;
-
- case 'z':
- format++;
- if (*format == 'u')
- error_uinteger (spec[n++].u.sizeval);
- else
- error_integer (spec[n++].u.ssizeval);
- break;
-
- case 't':
- format++;
- if (*format == 'u')
- {
- unsigned long long a = spec[n++].u.ptrdiffval, m;
-#ifdef PTRDIFF_MAX
- m = PTRDIFF_MAX;
-#else
- m = INTTYPE_MAXIMUM (ptrdiff_t);
-#endif
- m = 2 * m + 1;
- error_uinteger (a & m);
- }
- else
- error_integer (spec[n++].u.ptrdiffval);
- break;
- }
- }
-
- error_char ('\n');
-}
-
-
-/* Wrapper for error_print(). */
-
-static void
-error_printf (const char *gmsgid, ...)
-{
- va_list argp;
-
- va_start (argp, gmsgid);
- error_print ("", _(gmsgid), argp);
- va_end (argp);
-}
-
-
/* Clear any output buffered in a pretty-print output_buffer. */
static void