This commit adds the diagnostics infrastructure for the Algol 68 front-end.
Signed-off-by: Jose E. Marchesi <[email protected]> Co-authored-by: Marcel van der Veer <[email protected]> gcc/ChangeLog * algol68/a68-diagnostics.cc: New file. --- gcc/algol68/a68-diagnostics.cc | 360 +++++++++++++++++++++++++++++++++ 1 file changed, 360 insertions(+) create mode 100644 gcc/algol68/a68-diagnostics.cc diff --git a/gcc/algol68/a68-diagnostics.cc b/gcc/algol68/a68-diagnostics.cc new file mode 100644 index 00000000000..f1b0513dc38 --- /dev/null +++ b/gcc/algol68/a68-diagnostics.cc @@ -0,0 +1,360 @@ +/* Error and warning routines. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + <http://www.gnu.org/licenses/>. */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "diagnostic.h" + +#include "a68.h" + +/* + * Error handling routines. + */ + +#define TABULATE(n) (8 * (n / 8 + 1) - n) + +/* Severities handled by the DIAGNOSTIC function defined below. */ + +#define A68_ERROR 0 +#define A68_WARNING 1 +#define A68_FATAL 2 +#define A68_SCAN_ERROR 3 +#define A68_INFORM 4 + +/* Give a diagnostic message. */ + +static int +diagnostic (int sev, int opt, + NODE_T *p, + LINE_T *line, + char *pos, + const char *loc_str, va_list args) +{ + int res = 0; + MOID_T *moid = NO_MOID; + const char *t = loc_str; + char b[BUFFER_SIZE]; + + b[0] = '\0'; + + /* + * Synthesize diagnostic message. + * + * Legend for special symbols: + * * as first character, copy rest of string literally + * @ non terminal + * A non terminal + * B keyword + * C context + * D argument in decimal + * H char argument + * K 'LONG' + * L line number + * M moid - if error mode return without giving a message + * N mode - M_NIL + * O moid - operand + * S quoted symbol, when possible with typographical display features + * X expected attribute + * Y string literal. + * Z quoted string literal. */ + + if (t[0] == '*') + a68_bufcat (b, &t[1], BUFFER_SIZE); + else + while (t[0] != '\0') + { + if (t[0] == '@') + { + const char *nt = a68_attribute_name (ATTRIBUTE (p)); + if (t != NO_TEXT) + a68_bufcat (b, nt, BUFFER_SIZE); + else + a68_bufcat (b, "construct", BUFFER_SIZE); + } + else if (t[0] == 'A') + { + enum a68_attribute att = (enum a68_attribute) va_arg (args, int); + const char *nt = a68_attribute_name (att); + if (nt != NO_TEXT) + a68_bufcat (b, nt, BUFFER_SIZE); + else + a68_bufcat (b, "construct", BUFFER_SIZE); + } + else if (t[0] == 'B') + { + enum a68_attribute att = (enum a68_attribute) va_arg (args, int); + KEYWORD_T *nt = a68_find_keyword_from_attribute (A68 (top_keyword), att); + if (nt != NO_KEYWORD) + { + a68_bufcat (b, "\"", BUFFER_SIZE); + a68_bufcat (b, TEXT (nt), BUFFER_SIZE); + a68_bufcat (b, "\"", BUFFER_SIZE); + } + else + a68_bufcat (b, "keyword", BUFFER_SIZE); + } + else if (t[0] == 'C') + { + int att = va_arg (args, int); + if (att == NO_SORT) + a68_bufcat (b, "this", BUFFER_SIZE); + if (att == SOFT) + a68_bufcat (b, "a soft", BUFFER_SIZE); + else if (att == WEAK) + a68_bufcat (b, "a weak", BUFFER_SIZE); + else if (att == MEEK) + a68_bufcat (b, "a meek", BUFFER_SIZE); + else if (att == FIRM) + a68_bufcat (b, "a firm", BUFFER_SIZE); + else if (att == STRONG) + a68_bufcat (b, "a strong", BUFFER_SIZE); + } + else if (t[0] == 'D') + { + int a = va_arg (args, int); + BUFFER d; + BUFCLR (d); + if (snprintf (d, SNPRINTF_SIZE, "%d", a) < 0) + gcc_unreachable (); + a68_bufcat (b, d, BUFFER_SIZE); + } + else if (t[0] == 'H') + { + char *a = va_arg (args, char *); + char d[SMALL_BUFFER_SIZE]; + if (snprintf (d, (size_t) SMALL_BUFFER_SIZE, "\"%c\"", a[0]) < 0) + gcc_unreachable (); + a68_bufcat (b, d, BUFFER_SIZE); + } + else if (t[0] == 'K') + a68_bufcat (b, "LONG", BUFFER_SIZE); + else if (t[0] == 'L') + { + LINE_T *a = va_arg (args, LINE_T *); + char d[SMALL_BUFFER_SIZE]; + gcc_assert (a != NO_LINE); + if (NUMBER (a) == 0) + a68_bufcat (b, "in standard environment", BUFFER_SIZE); + else + { + if (p != NO_NODE && NUMBER (a) == LINE_NUMBER (p)) + { + if (snprintf (d, (size_t) SMALL_BUFFER_SIZE, "in this line") < 0) + gcc_unreachable (); + } + else + { + if (snprintf (d, (size_t) SMALL_BUFFER_SIZE, "in line %d", NUMBER (a)) < 0) + gcc_unreachable (); + } + a68_bufcat (b, d, BUFFER_SIZE); + } + } + else if (t[0] == 'M') + { + moid = va_arg (args, MOID_T *); + if (moid == NO_MOID || moid == M_ERROR) + moid = M_UNDEFINED; + + if (IS (moid, SERIES_MODE)) + { + if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) + a68_bufcat (b, a68_moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), + BUFFER_SIZE); + else + a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE); + } + else + a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE); + } + else if (t[0] == 'N') + { + a68_bufcat (b, "NIL name of mode ", BUFFER_SIZE); + moid = va_arg (args, MOID_T *); + if (moid != NO_MOID) + a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE); + } + else if (t[0] == 'O') + { + moid = va_arg (args, MOID_T *); + if (moid == NO_MOID || moid == M_ERROR) + moid = M_UNDEFINED; + if (moid == M_VOID) + a68_bufcat (b, "UNION (VOID, ..)", BUFFER_SIZE); + else if (IS (moid, SERIES_MODE)) + { + if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) + a68_bufcat (b, a68_moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE); + else + a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE); + } + else + a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE); + } + else if (t[0] == 'S') + { + if (p != NO_NODE && NSYMBOL (p) != NO_TEXT) + { + const char *txt = NSYMBOL (p); + char *sym = NCHAR_IN_LINE (p); + int n = 0, size = (int) strlen (txt); + + a68_bufcat (b, "\"", BUFFER_SIZE); + if (txt[0] != sym[0] || (int) strlen (sym) < size) + a68_bufcat (b, txt, BUFFER_SIZE); + else + { + while (n < size) + { + if (ISPRINT (sym[0])) + { + char str[2]; + str[0] = sym[0]; + str[1] = '\0'; + a68_bufcat (b, str, BUFFER_SIZE); + } + if (TOLOWER (txt[0]) == TOLOWER (sym[0])) + { + txt++; + n++; + } + sym++; + } + } + a68_bufcat (b, "\"", BUFFER_SIZE); + } + else + a68_bufcat (b, "symbol", BUFFER_SIZE); + } + else if (t[0] == 'V') + a68_bufcat (b, PACKAGE_STRING, BUFFER_SIZE); + else if (t[0] == 'X') + { + enum a68_attribute att = (enum a68_attribute) (va_arg (args, int)); + const char *att_name = a68_attribute_name (att); + a68_bufcat (b, att_name, BUFFER_SIZE); + } + else if (t[0] == 'Y') + { + char *loc_string = va_arg (args, char *); + a68_bufcat (b, loc_string, BUFFER_SIZE); + } + else if (t[0] == 'Z') + { + char *loc_string = va_arg (args, char *); + a68_bufcat (b, "\"", BUFFER_SIZE); + a68_bufcat (b, loc_string, BUFFER_SIZE); + a68_bufcat (b, "\"", BUFFER_SIZE); + } + else + { + char q[2]; + q[0] = t[0]; + q[1] = '\0'; + a68_bufcat (b, q, BUFFER_SIZE); + } + t++; + } + + /* Construct a diagnostic message. */ + if (sev == A68_WARNING) + WARNING_COUNT (&A68_JOB)++; + else + ERROR_COUNT (&A68_JOB)++; + + /* Emit the corresponding GCC diagnostic at the proper location. */ + location_t loc = UNKNOWN_LOCATION; + + if (p != NO_NODE) + loc = a68_get_node_location (p); + else if (line != NO_LINE) + { + if (pos == NO_TEXT) + pos = STRING (line); + loc = a68_get_line_location (line, pos); + } + + switch (sev) + { + case A68_SCAN_ERROR: error_at (loc, "%s", b); exit (FATAL_EXIT_CODE); + case A68_FATAL: fatal_error (loc, "%s", b); break; + case A68_INFORM: inform (loc, b); break; + case A68_WARNING: res = warning_at (loc, opt, "%s", b); break; + case A68_ERROR: error_at (loc, "%s", b); break; + default: + gcc_unreachable (); + } + + return res; +} + +/* Give an intelligible error and exit. A line is provided rather than a + node so this can be used at scanning time. */ + +void +a68_scan_error (LINE_T * u, char *v, const char *txt, ...) +{ + va_list args; + + va_start (args, txt); + diagnostic (A68_SCAN_ERROR, 0, NO_NODE, u, v, txt, args); + va_end (args); +} + +/* Report a compilation error. */ + +void +a68_error (NODE_T *p, const char *loc_str, ...) +{ + va_list args; + + va_start (args, loc_str); + diagnostic (A68_ERROR, 0, p, NO_LINE, NO_TEXT, loc_str, args); va_end (args); +} + +/* Report a compilation warning. */ + +int +a68_warning (NODE_T *p, int opt, + const char *loc_str, ...) +{ + int res; + va_list args; + + va_start (args, loc_str); + res = diagnostic (A68_WARNING, opt, p, NO_LINE, NO_TEXT, loc_str, args); + va_end (args); + return res; +} + +/* Report a compilation note. */ + +void +a68_inform (NODE_T *p, const char *loc_str, ...) +{ + va_list args; + + va_start (args, loc_str); + diagnostic (A68_INFORM, 0, p, NO_LINE, NO_TEXT, loc_str, args); + va_end (args); +} -- 2.30.2
