This commit changes the Algol 68 front-end diagnostics so it uses regular format strings as recognized as pp_format, instead of the upper-letter tags inherited from Genie.
Signed-off-by: Jose E. Marchesi <[email protected]> gcc/algol68/ChangeLog * a68-pretty-print.h: New file. * a68.h: Mark prototypes of diagnostic functions with ATTRIBUTE_A68_DIAG. * a68-diagnostics.cc (diagnostic): Do not translate upper-case tags and pass a copy of the va_list `args' to diagnostic_set_info. Mark with ATTRIBUTE_A68_DIAG. * a68-imports-archive.cc: Convert to use standard error format tags. * a68-parser-victal.cc: Likewise. * a68-parser-top-down.cc: Likewise. * a68-parser-taxes.cc: Likewise. * a68-parser-scanner.cc: Likeise. * a68-parser-moids-check.cc: Likewise. * a68-parser-modes.cc: Likewise. * a68-parser-extract.cc: Likewise. * a68-parser-pragmat.cc: Likewise. * a68-parser-scope.cc: Likewise. * a68-parser-brackets.cc: Likewise. * a68-parser-bottom-up.cc: LIkewise. * a68-moids-diagnostics.cc: Likewise. * a68-imports.cc: Likewise. --- gcc/algol68/a68-diagnostics.cc | 222 +----------------------- gcc/algol68/a68-imports-archive.cc | 48 ++--- gcc/algol68/a68-imports.cc | 18 +- gcc/algol68/a68-moids-diagnostics.cc | 56 ++++-- gcc/algol68/a68-parser-bottom-up.cc | 72 +++++--- gcc/algol68/a68-parser-brackets.cc | 11 +- gcc/algol68/a68-parser-extract.cc | 40 ++++- gcc/algol68/a68-parser-modes.cc | 35 +++- gcc/algol68/a68-parser-moids-check.cc | 106 ++++++++--- gcc/algol68/a68-parser-pragmat.cc | 6 +- gcc/algol68/a68-parser-scanner.cc | 12 +- gcc/algol68/a68-parser-scope.cc | 21 ++- gcc/algol68/a68-parser-taxes.cc | 28 +-- gcc/algol68/a68-parser-top-down.cc | 20 ++- gcc/algol68/a68-parser-victal.cc | 30 ++-- gcc/algol68/a68-pretty-print.h | 241 ++++++++++++++++++++++++++ gcc/algol68/a68.h | 12 +- 17 files changed, 593 insertions(+), 385 deletions(-) create mode 100644 gcc/algol68/a68-pretty-print.h diff --git a/gcc/algol68/a68-diagnostics.cc b/gcc/algol68/a68-diagnostics.cc index 254be5f49b2..e809f0987cc 100644 --- a/gcc/algol68/a68-diagnostics.cc +++ b/gcc/algol68/a68-diagnostics.cc @@ -26,6 +26,7 @@ #include "diagnostic.h" #include "a68.h" +#include "a68-pretty-print.h" /* * Error handling routines. @@ -41,227 +42,17 @@ #define A68_SCAN_ERROR 3 #define A68_INFORM 4 -/* Auxiliary function used to grow an obstack by the contents of some given - string. */ - -static void -obstack_append_str (obstack *b, const char *str) -{ - obstack_grow (b, str, strlen (str)); -} - /* Give a diagnostic message. */ -#if __GNUC__ >= 10 -#pragma GCC diagnostic ignored "-Wsuggest-attribute=format" -#endif - +ATTRIBUTE_A68_DIAG(6,0) static bool diagnostic (int sev, int opt, NODE_T *p, LINE_T *line, char *pos, - const char *loc_str, va_list args) + const char *format, va_list args) { int res = 0; - MOID_T *moid = NO_MOID; - const char *t = loc_str; - obstack b; - - /* - * Synthesize diagnostic message. - * - * Legend for special symbols: - * * as first character, copy rest of string literally - * @ AST node - * A AST node attribute - * B keyword - * C context - * L line number - * M moid - if error mode return without giving a message - * O moid - operand - * S quoted symbol, when possible with typographical display features - * X expected attribute - * Y string literal. - * Z quoted string. */ - - static va_list argp; /* Note this is empty. */ - gcc_obstack_init (&b); - - if (t[0] == '*') - obstack_append_str (&b, t + 1); - else - while (t[0] != '\0') - { - if (t[0] == '@') - { - const char *nt = a68_attribute_name (ATTRIBUTE (p)); - if (t != NO_TEXT) - obstack_append_str (&b, nt); - else - obstack_append_str (&b, "construct"); - } - 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) - obstack_append_str (&b, nt); - else - obstack_append_str (&b, "construct"); - } - 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) - { - const char *strop_keyword = a68_strop_keyword (TEXT (nt)); - - obstack_append_str (&b, "%<"); - obstack_append_str (&b, strop_keyword); - obstack_append_str (&b, "%>"); - } - else - obstack_append_str (&b, "keyword"); - } - else if (t[0] == 'C') - { - int att = va_arg (args, int); - const char *sort = NULL; - - switch (att) - { - case NO_SORT: sort = "this"; break; - case SOFT: sort = "a soft"; break; - case WEAK: sort = "a weak"; break; - case MEEK: sort = "a meek"; break; - case FIRM: sort = "a firm"; break; - case STRONG: sort = "a strong"; break; - default: - gcc_unreachable (); - } - - obstack_append_str (&b, sort); - } - else if (t[0] == 'L') - { - LINE_T *a = va_arg (args, LINE_T *); - gcc_assert (a != NO_LINE); - if (NUMBER (a) == 0) - obstack_append_str (&b, "in standard environment"); - else if (p != NO_NODE && NUMBER (a) == LINE_NUMBER (p)) - obstack_append_str (&b, "in this line"); - else - { - char d[18]; - if (snprintf (d, 18, "in line %d", NUMBER (a)) < 0) - gcc_unreachable (); - obstack_append_str (&b, d); - } - } - else if (t[0] == 'M') - { - const char *moidstr = NULL; - - 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) - moidstr = a68_moid_to_string (MOID (PACK (moid)), - MOID_ERROR_WIDTH, p); - else - moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); - } - else - moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); - - obstack_append_str (&b, "%<"); - obstack_append_str (&b, moidstr); - obstack_append_str (&b, "%>"); - } - 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) - obstack_append_str (&b, "UNION (VOID, ..)"); - else if (IS (moid, SERIES_MODE)) - { - const char *moidstr = NULL; - - if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) - moidstr = a68_moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p); - else - moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); - obstack_append_str (&b, moidstr); - } - else - { - const char *moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); - obstack_append_str (&b, moidstr); - } - } - 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); - - obstack_append_str (&b, "%<"); - if (txt[0] != sym[0] || (int) strlen (sym) < size) - obstack_append_str (&b, txt); - else - { - while (n < size) - { - if (ISPRINT (sym[0])) - obstack_1grow (&b, sym[0]); - if (TOLOWER (txt[0]) == TOLOWER (sym[0])) - { - txt++; - n++; - } - sym++; - } - } - obstack_append_str (&b, "%>"); - } - else - obstack_append_str (&b, "symbol"); - } - else if (t[0] == 'X') - { - enum a68_attribute att = (enum a68_attribute) (va_arg (args, int)); - const char *att_name = a68_attribute_name (att); - obstack_append_str (&b, att_name); - } - else if (t[0] == 'Y') - { - char *loc_string = va_arg (args, char *); - obstack_append_str (&b, loc_string); - } - else if (t[0] == 'Z') - { - char *str = va_arg (args, char *); - obstack_append_str (&b, "%<"); - obstack_append_str (&b, str); - obstack_append_str (&b, "%>"); - } - else - obstack_1grow (&b, t[0]); - - t++; - } - - obstack_1grow (&b, '\0'); - char *format = (char *) obstack_finish (&b); /* Construct a diagnostic message. */ if (sev == A68_WARNING) @@ -305,9 +96,12 @@ diagnostic (int sev, int opt, gcc_unreachable (); } - diagnostic_set_info (&diagnostic, format, - &argp, + va_list cargs; + va_copy (cargs, args); + diagnostic_set_info (&diagnostic, format, &cargs, &rich_loc, kind); + va_end (cargs); + if (opt != 0) diagnostic.m_option_id = opt; res = diagnostic_report_diagnostic (global_dc, &diagnostic); diff --git a/gcc/algol68/a68-imports-archive.cc b/gcc/algol68/a68-imports-archive.cc index ee504bc2110..2fcbdc2b142 100644 --- a/gcc/algol68/a68-imports-archive.cc +++ b/gcc/algol68/a68-imports-archive.cc @@ -254,7 +254,7 @@ Archive_file::initialize() struct stat st; if (fstat(this->fd_, &st) < 0) { - a68_error (NO_NODE, "Z: doing stat", this->filename_.c_str()); + a68_error (NO_NODE, "%s: doing stat", this->filename_.c_str()); return false; } this->filesize_ = st.st_size; @@ -263,7 +263,7 @@ Archive_file::initialize() if (::lseek(this->fd_, 0, SEEK_SET) < 0 || ::read(this->fd_, buf, sizeof(armagt)) != sizeof(armagt)) { - a68_error (NO_NODE, "Z: reading from archive", this->filename_.c_str()); + a68_error (NO_NODE, "%s: reading from archive", this->filename_.c_str()); return false; } if (memcmp(buf, armagt, sizeof(armagt)) == 0) @@ -288,7 +288,7 @@ Archive_file::initialize_big_archive() if (::lseek(this->fd_, 0, SEEK_SET) < 0 || ::read(this->fd_, &flhdr, sizeof(flhdr)) != sizeof(flhdr)) { - a68_error (NO_NODE, "Z: could not read archive header", + a68_error (NO_NODE, "%s: could not read archive header", this->filename_.c_str()); return false; } @@ -300,7 +300,7 @@ Archive_file::initialize_big_archive() char* buf = new char[sizeof(flhdr.fl_fstmoff) + 1]; memcpy(buf, flhdr.fl_fstmoff, sizeof(flhdr.fl_fstmoff)); a68_error (NO_NODE, - ("Z: malformed first member offset in archive header" + ("%s: malformed first member offset in archive header" " (expected decimal, got Z)"), this->filename_.c_str(), buf); delete[] buf; @@ -343,7 +343,7 @@ Archive_file::initialize_archive() char* rdbuf = new char[size]; if (::read(this->fd_, rdbuf, size) != size) { - a68_error (NO_NODE, "Z: could not read extended names", + a68_error (NO_NODE, "%s: could not read extended names", filename.c_str()); delete[] rdbuf; return false; @@ -363,7 +363,7 @@ Archive_file::read(off_t offset, off_t size, char* buf) if (::lseek(this->fd_, offset, SEEK_SET) < 0 || ::read(this->fd_, buf, size) != size) { - a68_error (NO_NODE, "Z: reading from archive", this->filename_.c_str()); + a68_error (NO_NODE, "%s: reading from archive", this->filename_.c_str()); return false; } return true; @@ -404,7 +404,7 @@ Archive_file::read_header(off_t off, std::string* pname, off_t* size, { if (::lseek(this->fd_, off, SEEK_SET) < 0) { - a68_error (NO_NODE, "Z: seeking in archive", this->filename_.c_str()); + a68_error (NO_NODE, "%s: seeking in archive", this->filename_.c_str()); return false; } if (this->is_big_archive_) @@ -426,12 +426,12 @@ Archive_file::read_big_archive_header(off_t off, std::string* pname, if (got != sizeof hdr) { if (got < 0) - a68_error (NO_NODE, "Z: reading from archive", this->filename_.c_str()); + a68_error (NO_NODE, "%s: reading from archive", this->filename_.c_str()); else if (got > 0) - a68_error (NO_NODE, "Z short entry header at L", + a68_error (NO_NODE, "%qs short entry header at %ld", this->filename_.c_str(), static_cast<long>(off)); else - a68_error (NO_NODE, "Z: unexpected EOF at L", + a68_error (NO_NODE, "%s: unexpected EOF at %ld", this->filename_.c_str(), static_cast<long>(off)); } @@ -441,7 +441,7 @@ Archive_file::read_big_archive_header(off_t off, std::string* pname, char* buf = new char[sizeof(hdr.ar_size) + 1]; memcpy(buf, hdr.ar_size, sizeof(hdr.ar_size)); a68_error (NO_NODE, - ("Z: malformed size in entry header at L" + ("%s: malformed size in entry header at %ld" " (expected decimal, got %s)"), this->filename_.c_str(), static_cast<long>(off), buf); delete[] buf; @@ -455,7 +455,7 @@ Archive_file::read_big_archive_header(off_t off, std::string* pname, char* buf = new char[sizeof(hdr.ar_namlen) + 1]; memcpy(buf, hdr.ar_namlen, sizeof(hdr.ar_namlen)); a68_error (NO_NODE, - ("Z: malformed name length in entry header at L" + ("%s: malformed name length in entry header at %ld" " (expected decimal, got %s)"), this->filename_.c_str(), static_cast<long>(off), buf); delete[] buf; @@ -467,7 +467,7 @@ Archive_file::read_big_archive_header(off_t off, std::string* pname, if (got != namlen) { a68_error (NO_NODE, - "Z: malformed member name in entry header at L", + "%s: malformed member name in entry header at %ld", this->filename_.c_str(), static_cast<long>(off)); delete[] rdbuf; return false; @@ -481,7 +481,7 @@ Archive_file::read_big_archive_header(off_t off, std::string* pname, char* buf = new char[sizeof(hdr.ar_nxtmem) + 1]; memcpy(buf, hdr.ar_nxtmem, sizeof(hdr.ar_nxtmem)); a68_error (NO_NODE, - ("Z: malformed next member offset in entry header at L" + ("%s: malformed next member offset in entry header at %ld" " (expected decimal, got %s)"), this->filename_.c_str(), static_cast<long>(off), buf); delete[] buf; @@ -509,12 +509,12 @@ Archive_file::read_archive_header(off_t off, std::string* pname, off_t* size, if (got != sizeof hdr) { if (got < 0) - a68_error (NO_NODE, "Z: reading from archive", this->filename_.c_str()); + a68_error (NO_NODE, "%s: reading from archive", this->filename_.c_str()); else if (got > 0) - a68_error (NO_NODE, "Z: short archive header at L", + a68_error (NO_NODE, "%s: short archive header at %ld", this->filename_.c_str(), static_cast<long>(off)); else - a68_error (NO_NODE, "Z: unexpected EOF at L", + a68_error (NO_NODE, "%s: unexpected EOF at %ld", this->filename_.c_str(), static_cast<long>(off)); } off_t local_nested_off; @@ -546,7 +546,7 @@ Archive_file::interpret_header(const Archive_header* hdr, off_t off, { if (memcmp(hdr->ar_fmag, arfmag, sizeof arfmag) != 0) { - a68_error (NO_NODE, "Z: malformed archive header at L", + a68_error (NO_NODE, "%s: malformed archive header at %lu", this->filename_.c_str(), static_cast<unsigned long>(off)); return false; } @@ -554,7 +554,7 @@ Archive_file::interpret_header(const Archive_header* hdr, off_t off, long local_size; if (!this->parse_decimal(hdr->ar_size, sizeof hdr->ar_size, &local_size)) { - a68_error (NO_NODE, "Z: malformed archive header size at L", + a68_error (NO_NODE, "%s: malformed archive header size at %lu", this->filename_.c_str(), static_cast<unsigned long>(off)); return false; } @@ -568,7 +568,7 @@ Archive_file::interpret_header(const Archive_header* hdr, off_t off, || name_end - hdr->ar_name >= static_cast<int>(sizeof hdr->ar_name)) { a68_error (NO_NODE, - "Z: malformed archive header name at L", + "%s: malformed archive header name at %lu", this->filename_.c_str(), static_cast<unsigned long>(off)); return false; } @@ -606,7 +606,7 @@ Archive_file::interpret_header(const Archive_header* hdr, off_t off, || (x == LONG_MAX && errno == ERANGE) || static_cast<size_t>(x) >= this->extended_names_.size()) { - a68_error (NO_NODE, "Z: bad extended name index at L", + a68_error (NO_NODE, "%s: bad extended name index at %lu", this->filename_.c_str(), static_cast<unsigned long>(off)); return false; } @@ -617,7 +617,7 @@ Archive_file::interpret_header(const Archive_header* hdr, off_t off, || name_end[-1] != '/') { a68_error (NO_NODE, - "Z: bad extended name entry at header L", + "%s: bad extended name entry at header %lu", this->filename_.c_str(), static_cast<unsigned long>(off)); return false; } @@ -676,7 +676,7 @@ Archive_file::get_file_and_offset(off_t off, const std::string& hdrname, int nfd = open(filename.c_str(), O_RDONLY | O_BINARY); if (nfd < 0) { - a68_error (NO_NODE, "Z: cannot open nested archive Z", + a68_error (NO_NODE, "%s: cannot open nested archive %s", this->filename_.c_str(), filename.c_str()); return false; } @@ -702,7 +702,7 @@ Archive_file::get_file_and_offset(off_t off, const std::string& hdrname, *memfd = open(filename.c_str(), O_RDONLY | O_BINARY); if (*memfd < 0) { - a68_error (NO_NODE, "Z: opening archive", filename.c_str()); + a68_error (NO_NODE, "%s: opening archive", filename.c_str()); return false; } *memoff = 0; diff --git a/gcc/algol68/a68-imports.cc b/gcc/algol68/a68-imports.cc index 3a69fdee7a8..c9385d742db 100644 --- a/gcc/algol68/a68-imports.cc +++ b/gcc/algol68/a68-imports.cc @@ -243,9 +243,9 @@ a68_find_object_export_data (const std::string& filename, if (errmsg != NULL) { if (err == 0) - a68_error (NO_NODE, "Z: Z", filename.c_str (), errmsg); + a68_error (NO_NODE, "%s: %s", filename.c_str (), errmsg); else - a68_error (NO_NODE, "Z: Z: Z", filename.c_str(), errmsg, + a68_error (NO_NODE, "%s: %s: %s", filename.c_str(), errmsg, xstrerror(err)); return NULL; } @@ -266,7 +266,7 @@ a68_find_export_data (const std::string &filename, int fd, size_t *psize) if (lseek (fd, 0, SEEK_SET) < 0) { - a68_error (NO_NODE, "lseek Z failed", filename.c_str ()); + a68_error (NO_NODE, "lseek %qs failed", filename.c_str ()); return NULL; } @@ -277,7 +277,7 @@ a68_find_export_data (const std::string &filename, int fd, size_t *psize) if (lseek (fd, 0, SEEK_SET) < 0) { - a68_error (NO_NODE, "lseek Z failed", filename.c_str ()); + a68_error (NO_NODE, "lseek %qs failed", filename.c_str ()); return NULL; } @@ -292,7 +292,7 @@ a68_find_export_data (const std::string &filename, int fd, size_t *psize) len = a68_file_size (fd); if (len == -1) { - a68_error (NO_NODE, "a68_file_size failed for Z", + a68_error (NO_NODE, "%<a68_file_size%> failed for %qs", filename.c_str ()); return NULL; } @@ -330,14 +330,14 @@ a68_find_export_data (const std::string &filename, int fd, size_t *psize) if (lseek (fd, 0, SEEK_SET) < 0) { - a68_error (NO_NODE, "lseek Z failed", filename.c_str ()); + a68_error (NO_NODE, "lseek %qs failed", filename.c_str ()); return NULL; } c = read (fd, buf, 8); if (c < 8) { - a68_error (NO_NODE, "read Z failed", filename.c_str ()); + a68_error (NO_NODE, "read %qs failed", filename.c_str ()); return NULL; } @@ -409,7 +409,7 @@ a68_try_packet_in_directory (const std::string &filename, size_t *psize) close (fd); - a68_error (NO_NODE, "file Z exists but does not contain any export data", + a68_error (NO_NODE, "file %qs exists but does not contain any export data", found_filename.c_str ()); return NULL; @@ -1429,7 +1429,7 @@ a68_open_packet (const char *module, const char *basename) const char *errstr = NULL; if (!a68_decode_moifs (exports_data, exports_data_size, &errstr)) { - a68_error (NO_NODE, "Y", errstr); + a68_error (NO_NODE, "%s", errstr); return NULL; } diff --git a/gcc/algol68/a68-moids-diagnostics.cc b/gcc/algol68/a68-moids-diagnostics.cc index a984fbc868f..180d7fb89a7 100644 --- a/gcc/algol68/a68-moids-diagnostics.cc +++ b/gcc/algol68/a68-moids-diagnostics.cc @@ -25,6 +25,9 @@ #include "options.h" #include "a68.h" +#include "a68-pretty-print.h" + +#include <string> /* Give accurate error message. */ @@ -75,7 +78,7 @@ a68_mode_error_text (NODE_T *n, MOID_T *p, MOID_T *q, int context, int deflex, i N++; len = strlen (txt); } - if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%%<%s%%>", + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%<%s%>", a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) < 0) gcc_unreachable (); N++; @@ -93,7 +96,7 @@ a68_mode_error_text (NODE_T *n, MOID_T *p, MOID_T *q, int context, int deflex, i gcc_unreachable (); len = strlen (txt); } - if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " cannot be coerced to %%<%s%%>", + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " cannot be coerced to %<%s%>", a68_moid_to_string (q, MOID_ERROR_WIDTH, n)) < 0) gcc_unreachable (); } @@ -134,7 +137,7 @@ a68_mode_error_text (NODE_T *n, MOID_T *p, MOID_T *q, int context, int deflex, i } } len = strlen (txt); - if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " cannot be coerced to %%<%s%%>", + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " cannot be coerced to %<%s%>", a68_moid_to_string (SLICE (SUB (q)), MOID_ERROR_WIDTH, n)) < 0) gcc_unreachable (); } @@ -168,7 +171,7 @@ a68_mode_error_text (NODE_T *n, MOID_T *p, MOID_T *q, int context, int deflex, i gcc_unreachable (); len = strlen (txt); } - if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%%<%s%%>", + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%<%s%>", a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) < 0) gcc_unreachable (); } @@ -209,7 +212,7 @@ a68_mode_error_text (NODE_T *n, MOID_T *p, MOID_T *q, int context, int deflex, i gcc_unreachable (); len = strlen (txt); } - if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%%<%s%%> cannot be coerced to %%<%s%%>", + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%<%s%> cannot be coerced to %<%s%>", a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n), a68_moid_to_string (MOID (v), MOID_ERROR_WIDTH, n)) < 0) gcc_unreachable (); @@ -230,19 +233,30 @@ a68_cannot_coerce (NODE_T *p, MOID_T *from, MOID_T *to, int context, int deflex, { const char *txt = a68_mode_error_text (p, from, to, context, deflex, 1); + a68_moid_format_token from1 (from); + a68_moid_format_token to1 (to); + a68_attr_format_token att1 ((a68_attribute) att); + a68_sort_format_token context1 (context); + if (att == STOP) { if (strlen (txt) == 0) - a68_error (p, "M cannot be coerced to M in C context", from, to, context); + a68_error (p, "%e cannot be coerced to %e in %e context", &from1, &to1, &context1); else - a68_error (p, "Y in C context", txt, context); + { + std::string fmt (txt); + a68_error (p, (fmt + " in %e context").c_str (), &context1); + } } else { if (strlen (txt) == 0) - a68_error (p, "M cannot be coerced to M in C-A", from, to, context, att); + a68_error (p, "%e cannot be coerced to %e in %e-%e", &from1, &to1, &context1, &att1); else - a68_error (p, "Y in C-A", txt, context, att); + { + std::string fmt (txt); + a68_error (p, (fmt + " in %e-%e").c_str (), &context1, &att1); + } } } @@ -255,12 +269,15 @@ a68_warn_for_voiding (NODE_T *p, SOID_T *x, SOID_T *y, int c) if (CAST (x) == false) { - if (MOID (x) == M_VOID && MOID (y) != M_ERROR && !(MOID (y) == M_VOID || !a68_is_nonproc (MOID (y)))) + if (MOID (x) == M_VOID + && MOID (y) != M_ERROR + && !(MOID (y) == M_VOID || !a68_is_nonproc (MOID (y)))) { - if (IS (p, FORMULA)) - a68_warning (p, OPT_Wvoiding, "value of M @ will be voided", MOID (y)); - else - a68_warning (p, OPT_Wvoiding, "value of M @ will be voided", MOID (y)); + a68_moid_format_token m1 (MOID (y)); + a68_construct_format_token c1 (p); + + a68_warning (p, OPT_Wvoiding, "value of %e %e will be voided", + &m1, &c1); } } } @@ -274,8 +291,15 @@ a68_semantic_pitfall (NODE_T *p, MOID_T *m, int c, int u) REF INT i := LOC INT := 0, which should probably be REF INT i = LOC INT := 0. */ if (IS (p, u)) - a68_warning (p, 0, "possibly unintended M A in M A", - MOID (p), u, m, c); + { + a68_moid_format_token m1 (MOID (p)); + a68_moid_format_token m2 (m); + a68_construct_format_token u1 ((a68_attribute) u); + a68_construct_format_token c1 ((a68_attribute) c); + + a68_warning (p, 0, "possibly unintended %e %e in %e %e", + &m1, &u1, &m2, &c1); + } else if (a68_is_one_of (p, UNIT, TERTIARY, SECONDARY, PRIMARY, STOP)) a68_semantic_pitfall (SUB (p), m, c, u); } diff --git a/gcc/algol68/a68-parser-bottom-up.cc b/gcc/algol68/a68-parser-bottom-up.cc index f1b06b1fbd3..2c0f9bd3541 100644 --- a/gcc/algol68/a68-parser-bottom-up.cc +++ b/gcc/algol68/a68-parser-bottom-up.cc @@ -101,6 +101,7 @@ #include "options.h" #include "a68.h" +#include "a68-pretty-print.h" /* Bottom-up parser, reduces all constructs. */ @@ -374,14 +375,14 @@ ignore_superfluous_semicolons (NODE_T *p) if (NEXT (p) != NO_NODE && IS (NEXT (p), SEMI_SYMBOL) && NEXT_NEXT (p) == NO_NODE) { - a68_warning (NEXT (p), 0, - "skipped superfluous A", ATTRIBUTE (NEXT (p))); + a68_attr_format_token a (ATTRIBUTE (NEXT (p))); + a68_warning (NEXT (p), 0, "skipped superfluous %e", &a); NEXT (p) = NO_NODE; } else if (IS (p, SEMI_SYMBOL) && a68_is_semicolon_less (NEXT (p))) { - a68_warning (p, 0, - "skipped superfluous A", ATTRIBUTE (p)); + a68_attr_format_token a (ATTRIBUTE (p)); + a68_warning (p, 0, "skipped superfluous %e", &a); if (PREVIOUS (p) != NO_NODE) NEXT (PREVIOUS (p)) = NEXT (p); PREVIOUS (NEXT (p)) = PREVIOUS (p); @@ -791,8 +792,7 @@ reduce_declarers (NODE_T *p, enum a68_attribute expect) if (SUB_NEXT (q) == NO_NODE) { - a68_error (NEXT (q), - "Y expected", "appropriate declarer"); + a68_error (NEXT (q), "appropriate declarer expected"); reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP); } else @@ -807,8 +807,7 @@ reduce_declarers (NODE_T *p, enum a68_attribute expect) } else { - a68_error (NEXT (q), - "Y expected", "appropriate declarer"); + a68_error (NEXT (q), "appropriate declarer expected"); reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP); } } @@ -819,8 +818,7 @@ reduce_declarers (NODE_T *p, enum a68_attribute expect) if (SUB_NEXT (q) == NO_NODE) { - a68_error (NEXT (q), - "Y expected", "appropriate declarer"); + a68_error (NEXT (q), "appropriate declarer expected"); reduce (q, NO_NOTE, NO_TICK, DECLARER, SHORTETY, INDICANT, STOP); } else @@ -833,8 +831,7 @@ reduce_declarers (NODE_T *p, enum a68_attribute expect) } else { - a68_error (NEXT (q), - "Y expected", "appropriate declarer"); + a68_error (NEXT (q), "appropriate declarer expected"); reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP); } } @@ -1347,8 +1344,12 @@ ambiguous_patterns (NODE_T *p) case COMPLEX_PATTERN: case BITS_PATTERN: if (last_pat != NO_NODE) - a68_error (q, "A and A must be separated by a comma-symbol", - ATTRIBUTE (last_pat), ATTRIBUTE (q)); + { + a68_attr_format_token a1 (ATTRIBUTE (last_pat)); + a68_attr_format_token a2 (ATTRIBUTE (q)); + a68_error (q, "%e and %e must be separated by a comma-symbol", + &a1, &a2); + } last_pat = q; break; case COMMA_SYMBOL: @@ -1756,7 +1757,10 @@ reduce_formulae (NODE_T * p) reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, FORMULA, STOP); } if (prio == 0 && siga) - a68_error (op, "S has no priority declaration"); + { + a68_symbol_format_token s (op); + a68_error (op, "%e has no priority declaration", &s); + } siga = true; while (siga) { @@ -1769,7 +1773,10 @@ reduce_formulae (NODE_T * p) if (operator_with_priority (q, prio)) reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, FORMULA, STOP); if (prio == 0 && siga) - a68_error (op2, "S has no priority declaration"); + { + a68_symbol_format_token s (op2); + a68_error (op2, "%e has no priority declaration", &s); + } } } } @@ -2299,7 +2306,10 @@ reduce_serial_clauses (NODE_T *p) if (IS (u, EXIT_SYMBOL)) { if (NEXT (u) == NO_NODE || !IS (NEXT (u), LABELED_UNIT)) - a68_error (u, "S must be followed by a labeled unit"); + { + a68_symbol_format_token s (u); + a68_error (u, "%e must be followed by a labeled unit", &s); + } } } @@ -2819,10 +2829,16 @@ recover_from_error (NODE_T * p, enum a68_attribute expect, bool suppress) if (strlen (seq) == 0) { if (ERROR_COUNT (&A68_JOB) == 0) - a68_error (w, "expected A", expect); + { + a68_attr_format_token a (expect); + a68_error (w, "expected %e", &a); + } } else - a68_error (w, "Y is an invalid A", seq, expect); + { + a68_attr_format_token a (expect); + a68_error (w, "%s is an invalid %e", seq, &a); + } if (ERROR_COUNT (&A68_JOB) >= MAX_ERRORS) longjmp (A68_PARSER (bottom_up_crash_exit), 1); @@ -2895,7 +2911,8 @@ reduce_erroneous_units (NODE_T *p) guide an unsuspecting user. */ if (a68_whether (q, SELECTOR, -SECONDARY, STOP)) { - a68_error (NEXT (q), "expected A", SECONDARY); + a68_attr_format_token a (SECONDARY); + a68_error (NEXT (q), "expected %e", &a); reduce (q, NO_NOTE, NO_TICK, UNIT, SELECTOR, WILDCARD, STOP); } @@ -2904,14 +2921,16 @@ reduce_erroneous_units (NODE_T *p) || a68_whether (q, TERTIARY, IS_SYMBOL, -TERTIARY, STOP) || a68_whether (q, -TERTIARY, IS_SYMBOL, -TERTIARY, STOP)) { - a68_error (NEXT (q), "expected A", TERTIARY); + a68_attr_format_token a (TERTIARY); + a68_error (NEXT (q), "expected %e", &a); reduce (q, NO_NOTE, NO_TICK, UNIT, WILDCARD, IS_SYMBOL, WILDCARD, STOP); } else if (a68_whether (q, -TERTIARY, ISNT_SYMBOL, TERTIARY, STOP) || a68_whether (q, TERTIARY, ISNT_SYMBOL, -TERTIARY, STOP) || a68_whether (q, -TERTIARY, ISNT_SYMBOL, -TERTIARY, STOP)) { - a68_error (NEXT (q), "expected A", TERTIARY); + a68_attr_format_token a (TERTIARY); + a68_error (NEXT (q), "expected %e", &a); reduce (q, NO_NOTE, NO_TICK, UNIT, WILDCARD, ISNT_SYMBOL, WILDCARD, STOP); } } @@ -2933,10 +2952,13 @@ a68_bottom_up_error_check (NODE_T *p) int k = 0; a68_count_pictures (SUB (p), &k); if (!(k == 0 || k == 2)) - a68_error (p, "incorrect number of pictures for A", - ATTRIBUTE (p)); + { + a68_attr_format_token a (ATTRIBUTE (p)); + a68_error (p, "incorrect number of pictures for %e", &a); + } } - else if (a68_is_one_of (p, DEFINING_INDICANT, DEFINING_IDENTIFIER, DEFINING_OPERATOR, STOP)) + else if (a68_is_one_of (p, + DEFINING_INDICANT, DEFINING_IDENTIFIER, DEFINING_OPERATOR, STOP)) { if (PUBLICIZED (p) && !PUBLIC_RANGE (TABLE (p))) a68_error (p, diff --git a/gcc/algol68/a68-parser-brackets.cc b/gcc/algol68/a68-parser-brackets.cc index ccb4ab47983..d66ac655e54 100644 --- a/gcc/algol68/a68-parser-brackets.cc +++ b/gcc/algol68/a68-parser-brackets.cc @@ -25,6 +25,7 @@ #include "coretypes.h" #include "a68.h" +#include "a68-pretty-print.h" /* After this checker, we know that at least brackets are matched. This stabilises later parser phases. @@ -193,15 +194,16 @@ bracket_check_parse (NODE_T *top, NODE_T *p) else if (q == NO_NODE) { char *diag = bracket_check_diagnose (top); - a68_error (p, "incorrect nesting, check for Y", + a68_error (p, "incorrect nesting, check for %s", (strlen (diag) > 0 ? diag : "missing or unmatched keyword")); longjmp (A68_PARSER (top_down_crash_exit), 1); } else { char *diag = bracket_check_diagnose (top); - a68_error (q, "unexpected X, check for Y", - ATTRIBUTE (q), + a68_attr_format_token a (ATTRIBUTE (q)); + + a68_error (q, "unexpected %e, check for %s", &a, (strlen (diag) > 0 ? diag : "missing or unmatched keyword")); longjmp (A68_PARSER (top_down_crash_exit), 1); } @@ -217,7 +219,6 @@ a68_check_parenthesis (NODE_T *top) if (!setjmp (A68_PARSER (top_down_crash_exit))) { if (bracket_check_parse (top, top) != NO_NODE) - a68_error (top, "incorrect nesting, check for Y", - "missing or unmatched keyword"); + a68_error (top, "incorrect nesting, check for missing or unmatched keyword"); } } diff --git a/gcc/algol68/a68-parser-extract.cc b/gcc/algol68/a68-parser-extract.cc index 312e624c4f5..82ceb776116 100644 --- a/gcc/algol68/a68-parser-extract.cc +++ b/gcc/algol68/a68-parser-extract.cc @@ -24,6 +24,7 @@ #include "coretypes.h" #include "a68.h" +#include "a68-pretty-print.h" /* This is part of the bottom-up parser. Here is a set of routines that gather definitions from phrases. This way we can apply tags before defining them. @@ -55,8 +56,11 @@ static void detect_redefined_keyword (NODE_T *p, int construct) { if (p != NO_NODE && a68_whether (p, KEYWORD, EQUALS_SYMBOL, STOP)) - a68_error (p, "attempt to redefine keyword Y in A", - NSYMBOL (p), construct); + { + a68_attr_format_token a ((a68_attribute) construct); + a68_error (p, "attempt to redefine keyword %s in %e", + NSYMBOL (p), &a); + } } /* Skip anything until a FED or ALT_ACCESS_SYMBOL is found. */ @@ -149,7 +153,10 @@ a68_elaborate_bold_tags (NODE_T *p) && IS (PREVIOUS (q), FORMAL_NEST_SYMBOL)) { if (strcmp (NSYMBOL (q), "C") != 0) - a68_error (q, "S is not a valid language indication"); + { + a68_symbol_format_token s (q); + a68_error (q, "%e is not a valid language indication", &s); + } else ATTRIBUTE (q) = LANGUAGE_INDICANT; } @@ -158,7 +165,10 @@ a68_elaborate_bold_tags (NODE_T *p) switch (find_tag_definition (TABLE (q), NSYMBOL (q))) { case 0: - a68_error (q, "tag S has not been declared properly"); + { + a68_symbol_format_token s (q); + a68_error (q, "indicant %e has not been declared properly", &s); + } break; case INDICANT: ATTRIBUTE (q) = INDICANT; @@ -220,7 +230,7 @@ a68_extract_revelation (NODE_T *q, const char *module, const char *filename, MOIF_T *moif = a68_open_packet (module, filename); if (moif == NULL) { - a68_error (q, "cannot find module Z", module); + a68_error (q, "cannot find module %qs", module); return; } @@ -605,7 +615,12 @@ a68_extract_priorities (NODE_T *p) NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), sym)); free (sym); if (len > 2 && NSYMBOL (q)[len - 2] == ':' && NSYMBOL (q)[len - 3] != '=') - a68_error (q, "probably a missing symbol near invalid operator S"); + { + a68_symbol_format_token s (q); + a68_error (q, + "probably a missing symbol near invalid operator %e", + &s); + } ATTRIBUTE (q) = DEFINING_OPERATOR; PUBLICIZED (q) = is_public; insert_alt_equals (q); @@ -722,8 +737,14 @@ a68_extract_operators (NODE_T *p) a68_bufcpy (sym, NSYMBOL (q), len + 1); sym[len - 1] = '\0'; NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), sym)); - if (len > 2 && NSYMBOL (q)[len - 2] == ':' && NSYMBOL (q)[len - 3] != '=') - a68_error (q, "probably a missing symbol near invalid operator S"); + if (len > 2 && NSYMBOL (q)[len - 2] == ':' + && NSYMBOL (q)[len - 3] != '=') + { + a68_symbol_format_token s (q); + a68_error (q, + "probably a missing symbol near invalid operator %e", + &s); + } ATTRIBUTE (q) = DEFINING_OPERATOR; PUBLICIZED (q) = is_public; insert_alt_equals (q); @@ -1035,7 +1056,8 @@ a68_extract_declarations (NODE_T *p) } else { - a68_error (q, "tag S has not been declared properly"); + a68_symbol_format_token s (q); + a68_error (q, "indicant %e has not been declared properly", &s); PRIO (INFO (q)) = 1; } } diff --git a/gcc/algol68/a68-parser-modes.cc b/gcc/algol68/a68-parser-modes.cc index ed010ded774..97e0cdef55e 100644 --- a/gcc/algol68/a68-parser-modes.cc +++ b/gcc/algol68/a68-parser-modes.cc @@ -24,6 +24,7 @@ #include "coretypes.h" #include "a68.h" +#include "a68-pretty-print.h" /* * Mode collection, equivalencing and derived modes. @@ -518,7 +519,7 @@ get_mode_from_declarer (NODE_T *p) /* Position of definition tells indicants apart. */ TAG_T *y = a68_find_tag_global (TABLE (p), INDICANT, NSYMBOL (p)); if (y == NO_TAG) - a68_error ( p, "tag Z has not been declared properly", NSYMBOL (p)); + a68_error (p, "tag %qs has not been declared properly", NSYMBOL (p)); else MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), INDICANT, 0, NODE (y), NO_MOID, NO_PACK); @@ -1217,7 +1218,10 @@ compute_derived_modes (MODULE_T *mod) for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) { if (IS_FLEX (z) && !IS (SUB (z), ROW_SYMBOL)) - a68_error (NODE (z), "M does not specify a well formed mode", z); + { + a68_moid_format_token m (z); + a68_error (NODE (z), "%e does not specify a well formed mode", &m); + } } /* Check on fields in structured modes f.i. STRUCT (REAL x, INT n, REAL x) is @@ -1236,7 +1240,8 @@ compute_derived_modes (MODULE_T *mod) { if (TEXT (s) == TEXT (t)) { - a68_error (NODE (z), "multiple declaration of field S"); + a68_symbol_format_token zs (NODE (z)); + a68_error (NODE (z), "multiple declaration of field %e", &zs); while (NEXT (s) != NO_PACK && TEXT (NEXT (s)) == TEXT (t)) FORWARD (s); x = false; @@ -1254,7 +1259,10 @@ compute_derived_modes (MODULE_T *mod) PACK_T *s = PACK (z); /* Discard unions with one member. */ if (a68_count_pack_members (s) == 1) - a68_error (NODE (z), "M must have at least two components", z); + { + a68_moid_format_token m (z); + a68_error (NODE (z), "%e must have at least two components", &m); + } /* Discard incestuous unions with firmly related modes. */ for (; s != NO_PACK; FORWARD (s)) { @@ -1265,7 +1273,10 @@ compute_derived_modes (MODULE_T *mod) if (MOID (t) != MOID (s)) { if (a68_is_firm (MOID (s), MOID (t))) - a68_error (NODE (z), "M has firmly related components", z); + { + a68_moid_format_token m (z); + a68_error (NODE (z), "%e has firmly related components", &m); + } } } } @@ -1276,7 +1287,11 @@ compute_derived_modes (MODULE_T *mod) MOID_T *n = a68_depref_completely (MOID (s)); if (IS (n, UNION_SYMBOL) && a68_is_subset (n, z, NO_DEFLEXING)) - a68_error (NODE (z), "M has firmly related subset M", z, n); + { + a68_moid_format_token m1 (z); + a68_moid_format_token m2 (n); + a68_error (NODE (z), "%e has firmly related subset %e", &m1, &m2); + } } } } @@ -1321,7 +1336,8 @@ a68_make_moid_list (MODULE_T *mod) { if (!is_well_formed (z, EQUIVALENT (z), false, false, true)) { - a68_error (NODE (z), "M does not specify a well formed mode", z); + a68_moid_format_token m (z); + a68_error (NODE (z), "%e does not specify a well formed mode", &m); cont = false; } } @@ -1334,7 +1350,10 @@ a68_make_moid_list (MODULE_T *mod) else if (NODE (z) != NO_NODE) { if (!is_well_formed (NO_MOID, z, false, false, true)) - a68_error (NODE (z), "M does not specify a well formed mode", z); + { + a68_moid_format_token m (z); + a68_error (NODE (z), "%e does not specify a well formed mode", &m); + } } } diff --git a/gcc/algol68/a68-parser-moids-check.cc b/gcc/algol68/a68-parser-moids-check.cc index f95f95890f6..ab664d415ba 100644 --- a/gcc/algol68/a68-parser-moids-check.cc +++ b/gcc/algol68/a68-parser-moids-check.cc @@ -92,6 +92,7 @@ #include "options.h" #include "a68.h" +#include "a68-pretty-print.h" /* Forward declarations of some of the functions defined below. */ @@ -515,7 +516,11 @@ mode_check_specified_unit_list (SOID_T **r, NODE_T *p, SOID_T *x, MOID_T *u) { MOID_T *m = MOID (NEXT_SUB (p)); if (u != NO_MOID && !a68_is_unitable (m, u, SAFE_DEFLEXING)) - a68_error (p, "M is neither component nor subset of M", m, u); + { + a68_moid_format_token m1 (m); + a68_moid_format_token m2 (u); + a68_error (p, "%e is neither component nor subset of %e", &m1, &m2); + } } else if (IS (p, UNIT)) @@ -590,7 +595,8 @@ mode_check_united_case_parts (SOID_T **ry, NODE_T *p, SOID_T *x) } else { - a68_error (NEXT_SUB (p), "M is not a united mode", u); + a68_moid_format_token m (u); + a68_error (NEXT_SUB (p), "%e is not a united mode", &m); return; } } @@ -709,15 +715,16 @@ mode_check_collateral (NODE_T *p, SOID_T *x, SOID_T *y) if (SORT (x) == STRONG) { if (MOID (x) == NO_MOID) - a68_error (p, "vacuum cannot have row elements (use a Y generator)", - "REF MODE"); + a68_error (p, "vacuum cannot have row elements (use a %qs generator)", + a68_strop_keyword ("REF MODE")); else if (IS_FLEXETY_ROW (MOID (x))) a68_make_soid (y, STRONG, M_VACUUM, 0); else { /* The syntax only allows vacuums in strong contexts with rowed modes. See rule 33d. */ - a68_error (p, "a vacuum is not a valid M", MOID (x)); + a68_moid_format_token m (MOID (x)); + a68_error (p, "a vacuum is not a valid %e", &m); a68_make_soid (y, STRONG, M_ERROR, 0); } } @@ -1103,7 +1110,8 @@ mode_check_monadic_operator (NODE_T *p, SOID_T *x, SOID_T *y) a68_make_soid (y, SORT (x), M_ERROR, 0); else if (u == M_HIP) { - a68_error (NEXT (p), "M construct is an invalid operand", u); + a68_moid_format_token m (u); + a68_error (NEXT (p), "%e construct is an invalid operand", &m); a68_make_soid (y, SORT (x), M_ERROR, 0); } else @@ -1111,7 +1119,9 @@ mode_check_monadic_operator (NODE_T *p, SOID_T *x, SOID_T *y) if (strchr (NOMADS, *(NSYMBOL (p))) != NO_TEXT) { t = NO_TAG; - a68_error (p, "monadic S cannot start with a character from Z", NOMADS); + a68_symbol_format_token s (p); + a68_error (p, "monadic %e cannot start with a character from %qs", + &s, NOMADS); a68_make_soid (y, SORT (x), M_ERROR, 0); } else @@ -1119,7 +1129,10 @@ mode_check_monadic_operator (NODE_T *p, SOID_T *x, SOID_T *y) t = find_operator (TABLE (p), NSYMBOL (p), u, NO_MOID); if (t == NO_TAG) { - a68_error (p, "monadic operator S O has not been declared", u); + a68_symbol_format_token s (p); + a68_opmoid_format_token o (u); + a68_error (p, "monadic operator %e %e has not been declared", + &s, &o); a68_make_soid (y, SORT (x), M_ERROR, 0); } } @@ -1192,12 +1205,14 @@ mode_check_formula (NODE_T *p, SOID_T *x, SOID_T *y) a68_make_soid (y, SORT (x), M_ERROR, 0); else if (u == M_HIP) { - a68_error (p, "M construct is an invalid operand", u); + a68_moid_format_token m (u); + a68_error (p, "%e construct is an invalid operand", &m); a68_make_soid (y, SORT (x), M_ERROR, 0); } else if (v == M_HIP) { - a68_error (q, "M construct is an invalid operand", u); + a68_moid_format_token m (u); + a68_error (q, "%e construct is an invalid operand", &m); a68_make_soid (y, SORT (x), M_ERROR, 0); } else @@ -1205,7 +1220,11 @@ mode_check_formula (NODE_T *p, SOID_T *x, SOID_T *y) TAG_T *op = find_operator (TABLE (NEXT (p)), NSYMBOL (NEXT (p)), u, v); if (op == NO_TAG) { - a68_error (NEXT (p), "dyadic operator O S O has not been declared", u, v); + a68_symbol_format_token s (NEXT (p)); + a68_opmoid_format_token o1 (u); + a68_opmoid_format_token o2 (v); + a68_error (NEXT (p), "dyadic operator %e %e %e has not been declared", + &o1, &s, &o2); a68_make_soid (y, SORT (x), M_ERROR, 0); } if (op != NO_TAG) @@ -1234,7 +1253,11 @@ mode_check_assignation (NODE_T *p, SOID_T *x, SOID_T *y) if (ATTRIBUTE (name_moid) != REF_SYMBOL) { if (A68_IF_MODE_IS_WELL (name_moid)) - a68_error (p, "M A does not yield a name", ori, ATTRIBUTE (SUB (p))); + { + a68_moid_format_token m (ori); + a68_attr_format_token a (ATTRIBUTE (SUB (p))); + a68_error (p, "%e %e does not yield a name", &m, &a); + } a68_make_soid (y, SORT (x), M_ERROR, 0); return; } @@ -1268,12 +1291,16 @@ mode_check_identity_relation (NODE_T *p, SOID_T *x, SOID_T *y) MOID_T *rhs = a68_deproc_completely (orir); if (A68_IF_MODE_IS_WELL (lhs) && lhs != M_HIP && ATTRIBUTE (lhs) != REF_SYMBOL) { - a68_error (ln, "M A does not yield a name", oril, ATTRIBUTE (SUB (ln))); + a68_moid_format_token m (oril); + a68_attr_format_token a (ATTRIBUTE (SUB (ln))); + a68_error (ln, "%e %e does not yield a name", &m, &a); lhs = M_ERROR; } if (A68_IF_MODE_IS_WELL (rhs) && rhs != M_HIP && ATTRIBUTE (rhs) != REF_SYMBOL) { - a68_error (rn, "M A does not yield a name", orir, ATTRIBUTE (SUB (rn))); + a68_moid_format_token m (orir); + a68_attr_format_token a (ATTRIBUTE (SUB (rn))); + a68_error (rn, "%e %e does not yield a name", &m, &a); rhs = M_ERROR; } if (lhs == M_HIP && rhs == M_HIP) @@ -1371,7 +1398,8 @@ mode_check_argument_list (SOID_T **r, NODE_T *p, PACK_T **x, PACK_T **v, PACK_T SOID_T z; if (SUB (p) != NO_NODE) { - a68_error (p, "syntax error detected in A", ARGUMENT); + a68_attr_format_token a (ARGUMENT); + a68_error (p, "syntax error detected in %e", &a); a68_make_soid (&z, STRONG, M_ERROR, 0); a68_add_mode_to_pack_end (v, M_VOID, NO_TEXT, p); a68_add_mode_to_pack_end (w, MOID (*x), NO_TEXT, p); @@ -1389,7 +1417,10 @@ mode_check_argument_list (SOID_T **r, NODE_T *p, PACK_T **x, PACK_T **v, PACK_T a68_add_to_soid_list (r, p, &z); } else if (IS (p, SUB_SYMBOL) && !OPTION_BRACKETS (&A68_JOB)) - a68_error (p, "syntax error detected in A", CALL); + { + a68_attr_format_token a (CALL); + a68_error (p, "syntax error detected in %e", &a); + } } } @@ -1484,7 +1515,8 @@ mode_check_call (NODE_T *p, MOID_T *n, SOID_T *x, SOID_T *y) PARTIAL_LOCALE (GINFO (p)) = a68_register_extra_mode (&TOP_MOID (&A68_JOB), PARTIAL_LOCALE (GINFO (p))); if (DIM (MOID (&d)) != DIM (n)) { - a68_error (p, "incorrect number of arguments for M", n); + a68_moid_format_token m (n); + a68_error (p, "incorrect number of arguments for %e", &m); a68_make_soid (y, SORT (x), SUB (n), 0); /* a68_make_soid (y, SORT (x), M_ERROR, 0);. */ } @@ -1496,7 +1528,8 @@ mode_check_call (NODE_T *p, MOID_T *n, SOID_T *x, SOID_T *y) a68_make_soid (y, SORT (x), SUB (n), 0); else { - a68_warning (NEXT (p), OPT_Wextensions, "@ is an extension"); + a68_construct_format_token c (NEXT (p)); + a68_warning (NEXT (p), OPT_Wextensions, "%e is an extension", &c); a68_make_soid (y, SORT (x), PARTIAL_PROC (GINFO (p)), 0); } } @@ -1515,8 +1548,11 @@ mode_check_slice (NODE_T *p, MOID_T *ori, SOID_T *x, SOID_T *y) if (n == NO_MOID || !(SLICE (DEFLEX (n)) != NO_MOID || a68_is_ref_row (n))) { if (A68_IF_MODE_IS_WELL (n)) - a68_error (p, "M A does not yield a row or procedure", - n, ATTRIBUTE (SUB (p))); + { + a68_moid_format_token m (n); + a68_attr_format_token a (ATTRIBUTE (SUB (p))); + a68_error (p, "%e %e does not yield a row or procedure", &m, &a); + } a68_make_soid (y, SORT (x), M_ERROR, 0); } @@ -1531,7 +1567,8 @@ mode_check_slice (NODE_T *p, MOID_T *ori, SOID_T *x, SOID_T *y) if ((subs + trims) != dim) { - a68_error (p, "incorrect number of indexers for M", n); + a68_moid_format_token m (n); + a68_error (p, "incorrect number of indexers for %e", &m); a68_make_soid (y, SORT (x), M_ERROR, 0); } else @@ -1595,7 +1632,10 @@ mode_check_specification (NODE_T *p, SOID_T *x, SOID_T *y) else { if (m != M_ERROR) - a68_error (p, "M construct must yield a routine or a row value", m); + { + a68_moid_format_token m1 (m); + a68_error (p, "%e construct must yield a routine or a row value", &m1); + } a68_make_soid (y, SORT (x), M_ERROR, 0); return PRIMARY; } @@ -1654,7 +1694,11 @@ mode_check_selection (NODE_T *p, SOID_T *x, SOID_T *y) if (t == NO_PACK) { if (A68_IF_MODE_IS_WELL (MOID (&d))) - a68_error (secondary, "M A does not yield a structured value", ori, ATTRIBUTE (secondary)); + { + a68_moid_format_token m (ori); + a68_attr_format_token a (ATTRIBUTE (secondary)); + a68_error (secondary, "%e %e does not yield a structured value", &m, &a); + } a68_make_soid (y, SORT (x), M_ERROR, 0); return; } @@ -1685,7 +1729,8 @@ mode_check_selection (NODE_T *p, SOID_T *x, SOID_T *y) FORWARD (t_2); } a68_make_soid (&d, NO_SORT, n, 0); - a68_error (p, "M has no field Z", str, fs); + a68_moid_format_token m (str); + a68_error (p, "%e has no field %qs", &m, fs); a68_make_soid (y, SORT (x), M_ERROR, 0); } @@ -1757,7 +1802,7 @@ mode_check_unit (NODE_T *p, SOID_T *x, SOID_T *y) if (att == STOP) { (void) a68_add_tag (TABLE (p), IDENTIFIER, p, M_ERROR, NORMAL_IDENTIFIER); - a68_error (p, "tag S has not been declared properly"); + a68_error (p, "tag %qs has not been declared properly", NSYMBOL (p)); MOID (p) = M_ERROR; } else @@ -1768,7 +1813,7 @@ mode_check_unit (NODE_T *p, SOID_T *x, SOID_T *y) else { (void) a68_add_tag (TABLE (p), IDENTIFIER, p, M_ERROR, NORMAL_IDENTIFIER); - a68_error (p, "tag S has not been declared properly"); + a68_error (p, "tag %qs has not been declared properly", NSYMBOL (p)); MOID (p) = M_ERROR; } } @@ -1808,7 +1853,11 @@ mode_check_unit (NODE_T *p, SOID_T *x, SOID_T *y) else if (a68_is_one_of (p, JUMP, SKIP, STOP)) { if (SORT (x) != STRONG) - a68_warning (p, 0, "@ should not be in C context", SORT (x)); + { + a68_construct_format_token c (p); + a68_sort_format_token s (SORT (x)); + a68_warning (p, 0, "%e should not be in %e context", &c, &s); + } /* a68_make_soid (y, STRONG, M_HIP, 0); */ a68_make_soid (y, SORT (x), M_HIP, 0); } @@ -1869,7 +1918,8 @@ mode_check_unit (NODE_T *p, SOID_T *x, SOID_T *y) { /* Additionally, the mode of the formal hole should be amenable to be somehow "translated" to C semantics. */ - a68_error (p, "formal hole cannot be of mode M", MOID (x)); + a68_moid_format_token m (MOID (x)); + a68_error (p, "formal hole cannot be of mode %e", &m); a68_make_soid (y, STRONG, M_ERROR, 0); } else if (NSYMBOL (str)[0] == '&' && !IS_REF (MOID (x))) diff --git a/gcc/algol68/a68-parser-pragmat.cc b/gcc/algol68/a68-parser-pragmat.cc index a31d509b404..530b0d81ab9 100644 --- a/gcc/algol68/a68-parser-pragmat.cc +++ b/gcc/algol68/a68-parser-pragmat.cc @@ -114,7 +114,7 @@ handle_access_in_pragmat (NODE_T *p, const char *pragmat, size_t pos) char *found; PARSE_WORD (pragmat, found); a68_error_in_pragmat (p, off, - "in %<access%> pragmat, expected string, found Z", + "in %<access%> pragmat, expected string, found %qs", found); return NULL; } @@ -128,7 +128,7 @@ handle_access_in_pragmat (NODE_T *p, const char *pragmat, size_t pos) if (pmodule != NULL) { a68_error_in_pragmat (p, pos + pragmat - beginning, - "module Z cannot appear in multiple %<access%> pragmats", + "module %qs cannot appear in multiple %<access%> pragmats", module); return NULL; } @@ -186,7 +186,7 @@ handle_pragmat (NODE_T *p) else { a68_error_in_pragmat (p, pragmat - NPRAGMAT (p), - "unrecognized pragmat Z", word); + "unrecognized pragmat %qs", word); break; } } diff --git a/gcc/algol68/a68-parser-scanner.cc b/gcc/algol68/a68-parser-scanner.cc index 8c8b06464fe..af1251f125d 100644 --- a/gcc/algol68/a68-parser-scanner.cc +++ b/gcc/algol68/a68-parser-scanner.cc @@ -31,6 +31,7 @@ #include "vec.h" #include "a68.h" +#include "a68-pretty-print.h" /* A few forward references of static functions defined in this file. */ @@ -1801,7 +1802,7 @@ string break character point")); } SCAN_ERROR (c != ',', *start_l, *ref_s, - "expected , or ) in string break"); + "expected %<,%> or %<)%> in string break"); } else { @@ -2271,9 +2272,12 @@ tokenise_source (NODE_T **root, int level, bool in_format, TOP_NODE (&A68_JOB) = q; *root = q; if (trailing != NO_TEXT) - a68_warning (q, 0, - "ignoring trailing character H in A", - trailing, att); + { + a68_attr_format_token a (att); + a68_warning (q, 0, + "ignoring trailing character %qs in %e", + trailing, &a); + } } /* Redirection in tokenising formats. The scanner is a recursive-descent type as to know when it scans a format text and when not. */ diff --git a/gcc/algol68/a68-parser-scope.cc b/gcc/algol68/a68-parser-scope.cc index 8203423bdbc..f9cf2357076 100644 --- a/gcc/algol68/a68-parser-scope.cc +++ b/gcc/algol68/a68-parser-scope.cc @@ -28,6 +28,7 @@ #include "options.h" #include "a68.h" +#include "a68-pretty-print.h" struct TUPLE_T { @@ -116,9 +117,17 @@ scope_check (SCOPE_T *top, int mask, int dest) if (ws != NO_MOID) { - if (IS_REF (ws) || IS (ws, PROC_SYMBOL) || IS (ws, FORMAT_SYMBOL) || IS (ws, UNION_SYMBOL)) - a68_warning (WHERE (s), OPT_Wscope, "M A is a potential scope violation", - MOID (WHERE (s)), ATTRIBUTE (WHERE (s))); + if (IS_REF (ws) + || IS (ws, PROC_SYMBOL) + || IS (ws, FORMAT_SYMBOL) + || IS (ws, UNION_SYMBOL)) + { + a68_moid_format_token m (MOID (WHERE (s))); + a68_attr_format_token a (ATTRIBUTE (WHERE (s))); + a68_warning (WHERE (s), OPT_Wscope, + "%e %e is a potential scope violation", + &m, &a); + } } STATUS_SET (WHERE (s), SCOPE_ERROR_MASK); errors++; @@ -147,7 +156,11 @@ check_identifier_usage (TAG_T *t, NODE_T *p) for (; p != NO_NODE; FORWARD (p)) { if (IS (p, IDENTIFIER) && TAX (p) == t && ATTRIBUTE (MOID (t)) != PROC_SYMBOL) - a68_warning (p, OPT_Wuninitialized, "identifier S might be used uninitialised"); + { + a68_symbol_format_token s (p); + a68_warning (p, OPT_Wuninitialized, + "identifier %e might be used uninitialised", &s); + } check_identifier_usage (t, SUB (p)); } } diff --git a/gcc/algol68/a68-parser-taxes.cc b/gcc/algol68/a68-parser-taxes.cc index 365cb66d59a..bfb6a6d02bf 100644 --- a/gcc/algol68/a68-parser-taxes.cc +++ b/gcc/algol68/a68-parser-taxes.cc @@ -25,6 +25,7 @@ #include "options.h" #include "a68.h" +#include "a68-pretty-print.h" /* * Symbol table handling, managing TAGS. @@ -265,7 +266,8 @@ bind_identifier_tag_to_symbol_table (NODE_T * p) MOID (p) = MOID (z); else { - a68_error (p, "tag S has not been declared properly"); + a68_error (p, "tag %qs has not been declared properly", + NSYMBOL (p)); z = a68_add_tag (TABLE (p), IDENTIFIER, p, M_ERROR, NORMAL_IDENTIFIER); MOID (p) = M_ERROR; } @@ -565,8 +567,10 @@ test_firmly_related_ops_local (NODE_T *p, TAG_T *s) if (t != NO_TAG) { - a68_error (p, "M Z is firmly related to M Z", - MOID (s), NSYMBOL (NODE (s)), MOID (t), + a68_moid_format_token m1 (MOID (s)); + a68_moid_format_token m2 (MOID (t)); + a68_error (p, "%e %qs is firmly related to %e %qs", + &m1, NSYMBOL (NODE (s)), &m2, NSYMBOL (NODE (t))); } else @@ -659,7 +663,7 @@ static void already_declared (NODE_T *n, int a) { if (find_tag_local (TABLE (n), a, NSYMBOL (n)) != NO_TAG) - a68_error (n, "multiple declaration of tag S"); + a68_error (n, "multiple declaration of tag %qs", NSYMBOL (n)); } /* Whether tag has already been declared in this range. */ @@ -668,7 +672,7 @@ static void already_declared_hidden (NODE_T *n, int a) { if (find_tag_local (TABLE (n), a, NSYMBOL (n)) != NO_TAG) - a68_error (n, "multiple declaration of tag S"); + a68_error (n, "multiple declaration of tag %qs", NSYMBOL (n)); TAG_T *s = a68_find_tag_global (PREVIOUS (TABLE (n)), a, NSYMBOL (n)); @@ -1108,17 +1112,21 @@ check_operator_dec (NODE_T *p, MOID_T *u) if (k < 1 || k > 2) { - a68_error (p, "incorrect number of operands for S"); + a68_symbol_format_token s (p); + a68_error (p, "incorrect number of operands for %e", &s); k = 0; } if (k == 1 && strchr (NOMADS, NSYMBOL (p)[0]) != NO_TEXT) { - a68_error (p, "monadic S cannot start with a character from Z", NOMADS); + a68_symbol_format_token s (p); + a68_error (p, "monadic %e cannot start with a character from %qs", + &s, NOMADS); } else if (k == 2 && !a68_find_tag_global (TABLE (p), PRIO_SYMBOL, NSYMBOL (p))) { - a68_error (p, "dyadic S has no priority declaration"); + a68_symbol_format_token s (p); + a68_error (p, "dyadic %e has no priority declaration", &s); } } @@ -1739,7 +1747,7 @@ unused (TAG_T *s) for (; s != NO_TAG; FORWARD (s)) { if (LINE_NUMBER (NODE (s)) > 0 && !USE (s)) - a68_warning (NODE (s), OPT_Wunused, "tag S is not used", NODE (s)); + a68_warning (NODE (s), OPT_Wunused, "tag %qs is not used", NSYMBOL (NODE (s))); } } @@ -1791,7 +1799,7 @@ a68_jumps_from_procs (NODE_T *p) && (a68_find_tag_global (TABLE (u), LABEL, NSYMBOL (u)) == NO_TAG)) { (void) a68_add_tag (TABLE (u), LABEL, u, NO_MOID, LOCAL_LABEL); - a68_error (u, "tag S has not been declared properly"); + a68_error (u, "tag %qs has not been declared properly", NSYMBOL (u)); } else USE (TAX (u)) = true; diff --git a/gcc/algol68/a68-parser-top-down.cc b/gcc/algol68/a68-parser-top-down.cc index 4a79e58217a..238749fcb66 100644 --- a/gcc/algol68/a68-parser-top-down.cc +++ b/gcc/algol68/a68-parser-top-down.cc @@ -24,6 +24,7 @@ #include "coretypes.h" #include "a68.h" +#include "a68-pretty-print.h" /* A few forward prototypes of functions defined below. */ @@ -164,12 +165,19 @@ top_down_diagnose (NODE_T *start, NODE_T *p, int clause, int expected) NODE_T *issue = (p != NO_NODE ? p : start); const char *strop_keyword = a68_strop_keyword (NSYMBOL (start)); + a68_line_format_token l (LINE (INFO (start)), issue); + a68_attr_format_token a1 ((a68_attribute) clause); + if (expected != 0) - a68_error (issue, "B expected in A, near Z L", - expected, clause, strop_keyword, LINE (INFO (start))); + { + + a68_attr_format_token a2 ((a68_attribute) expected); + a68_error (issue, "%e expected in %e, near %qs %e", + &a2, &a1, strop_keyword, &l); + } else - a68_error (issue, "missing or unbalanced keyword in A, near Z L", - clause, strop_keyword, LINE (INFO (start))); + a68_error (issue, "missing or unbalanced keyword in %e, near %qs %e", + &a1, strop_keyword, &l); } /* Check for premature exhaustion of tokens. */ @@ -179,7 +187,9 @@ tokens_exhausted (NODE_T *p, NODE_T *q) { if (p == NO_NODE) { - a68_error (q, "check for missing or unmatched keyword in clause starting at S"); + a68_symbol_format_token s (q); + a68_error (q, "check for missing or unmatched keyword in clause starting at %e", + &s); longjmp (A68_PARSER (top_down_crash_exit), 1); } } diff --git a/gcc/algol68/a68-parser-victal.cc b/gcc/algol68/a68-parser-victal.cc index a810d385555..fc7d8acd80a 100644 --- a/gcc/algol68/a68-parser-victal.cc +++ b/gcc/algol68/a68-parser-victal.cc @@ -34,7 +34,7 @@ static void victal_check_generator (NODE_T * p) { if (!victal_check_declarer (NEXT (p), ACTUAL_DECLARER_MARK)) - a68_error (p, "Y expected", "actual declarer"); + a68_error (p, "actual declarer expected"); } /* Check formal pack. */ @@ -71,11 +71,11 @@ victal_check_operator_dec (NODE_T *p) bool z = true; victal_check_formal_pack (NEXT (p), FORMAL_DECLARER_MARK, &z); if (!z) - a68_error (p, "Y expected", "formal declarers"); + a68_error (p, "formal declarers expected"); FORWARD (p); } if (!victal_check_declarer (NEXT (p), FORMAL_DECLARER_MARK)) - a68_error (p, "Y expected", "formal declarer"); + a68_error (p, "formal declarer expected"); } /* Check mode declaration. */ @@ -102,7 +102,7 @@ victal_check_mode_dec (NODE_T *p) else if (IS (p, DECLARER)) { if (!victal_check_declarer (p, ACTUAL_DECLARER_MARK)) - a68_error (p, "Y expected", "actual declarer"); + a68_error (p, "actual declarer expected"); } } } @@ -135,7 +135,7 @@ victal_check_variable_dec (NODE_T *p) else if (IS (p, DECLARER)) { if (!victal_check_declarer (p, ACTUAL_DECLARER_MARK)) - a68_error (p, "Y expected", "actual declarer"); + a68_error (p, "actual declarer expected"); victal_check_variable_dec (NEXT (p)); } } @@ -162,7 +162,7 @@ victal_check_identity_dec (NODE_T * p) else if (IS (p, DECLARER)) { if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) - a68_error (p, "Y expected", "formal declarer"); + a68_error (p, "formal declarer expected"); victal_check_identity_dec (NEXT (p)); } } @@ -199,11 +199,11 @@ victal_check_routine_text (NODE_T *p) bool z = true; victal_check_routine_pack (p, FORMAL_DECLARER_MARK, &z); if (!z) - a68_error (p, "Y expected", "formal declarers"); + a68_error (p, "formal declarers expected"); FORWARD (p); } if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) - a68_error (p, "Y expected", "formal declarer"); + a68_error (p, "formal declarer expected"); a68_victal_checker (NEXT (p)); } @@ -274,13 +274,13 @@ victal_check_declarer (NODE_T *p, int x) a68_victal_checker (SUB (p)); if (x == FORMAL_DECLARER_MARK) { - a68_error (p, "Y expected", "formal bounds"); + a68_error (p, "formal bounds expected"); (void) victal_check_declarer (NEXT (p), x); return true; } else if (x == VIRTUAL_DECLARER_MARK) { - a68_error (p, "Y expected", "virtual bounds"); + a68_error (p, "virtual bounds expected"); (void) victal_check_declarer (NEXT (p), x); return true; } @@ -292,7 +292,7 @@ victal_check_declarer (NODE_T *p, int x) a68_victal_checker (SUB (p)); if (x == ACTUAL_DECLARER_MARK) { - a68_error (p, "Y expected", "actual bounds"); + a68_error (p, "actual bounds expected"); (void) victal_check_declarer (NEXT (p), x); return true; } @@ -310,7 +310,7 @@ victal_check_declarer (NODE_T *p, int x) bool z = true; victal_check_union_pack (NEXT (p), FORMAL_DECLARER_MARK, &z); if (!z) - a68_error (p, "Y expected", "formal declarer pack"); + a68_error (p, "formal declarer pack expected"); return true; } else if (IS (p, PROC_SYMBOL)) @@ -320,11 +320,11 @@ victal_check_declarer (NODE_T *p, int x) bool z = true; victal_check_formal_pack (NEXT (p), FORMAL_DECLARER_MARK, &z); if (!z) - a68_error (p, "Y expected", "formal declarer"); + a68_error (p, "formal declarer expected"); FORWARD (p); } if (!victal_check_declarer (NEXT (p), FORMAL_DECLARER_MARK)) - a68_error (p, "Y expected", "formal declarer"); + a68_error (p, "formal declarer expected"); return true; } else @@ -338,7 +338,7 @@ victal_check_cast (NODE_T *p) { if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) { - a68_error (p, "Y expected", "formal declarer"); + a68_error (p, "formal declarer expected"); a68_victal_checker (NEXT (p)); } } diff --git a/gcc/algol68/a68-pretty-print.h b/gcc/algol68/a68-pretty-print.h new file mode 100644 index 00000000000..ef74c43089f --- /dev/null +++ b/gcc/algol68/a68-pretty-print.h @@ -0,0 +1,241 @@ +/* Pretty printers for Algol 68 front-end specific %e tags. + Copyright (C) 2026 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/>. */ + +#ifndef __A68_PRETTY_PRINT__ +#define __A68_PRETTY_PRINT__ + +#include "config.h" +#include "system.h" +#include "pretty-print.h" +#include "pretty-print-format-impl.h" +#include "pretty-print-markup.h" + +struct a68_format_token : public pp_element +{ +public: + struct value : public pp_token_custom_data::value + { + value (a68_format_token &token) + : m_token (token) + { + } + + value (const value &other) + : m_token (other.m_token) + { + } + + value (value &&other) + : m_token (other.m_token) + { + } + + value &operator= (const value &other) = delete; + value &operator= (value &&other) = delete; + ~value () + { + } + + void dump (FILE *out) const final override + { + fprintf (out, "%s", m_token.m_str); + } + + bool as_standard_tokens (pp_token_list &out) final override + { + out.push_back<pp_token_text> (label_text::borrow (m_token.m_str)); + return true; + } + + a68_format_token &m_token; + }; + + a68_format_token () + { + m_str = NULL; + } + + ~a68_format_token () + { + free (m_str); + } + + void add_to_phase_2 (pp_markup::context &ctxt) final override + { + auto val_ptr = std::make_unique<value> (*this); + ctxt.m_formatted_token_list->push_back<pp_token_custom_data> + (std::move (val_ptr)); + } + + char *m_str; +}; + + +struct a68_moid_format_token : public a68_format_token +{ +public: + a68_moid_format_token (MOID_T *m) + { + m_str = xstrdup (a68_moid_to_string (m, MOID_ERROR_WIDTH, NO_NODE)); + } +}; + +struct a68_opmoid_format_token : public a68_format_token +{ +public: + a68_opmoid_format_token (MOID_T *m) + { + if (m == NO_MOID || m == M_ERROR) + m = M_UNDEFINED; + + const char *str; + if (m == M_VOID) + str = (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING + ? "UNION (VOID, ..)" + : "union (void, ..)"); + else if (IS (m, SERIES_MODE)) + { + if (PACK (m) != NO_PACK && NEXT (PACK (m)) == NO_PACK) + str = a68_moid_to_string (MOID (PACK (m)), MOID_ERROR_WIDTH, NO_NODE); + else + str = a68_moid_to_string (m, MOID_ERROR_WIDTH, NO_NODE); + } + else + str = a68_moid_to_string (m, MOID_ERROR_WIDTH, NO_NODE); + + m_str = xstrdup (str); + } +}; + +struct a68_attr_format_token : public a68_format_token +{ +public: + a68_attr_format_token (enum a68_attribute a) + { + KEYWORD_T *nt = a68_find_keyword_from_attribute (A68 (top_keyword), a); + if (nt != NO_KEYWORD) + m_str = xstrdup (a68_strop_keyword (TEXT (nt))); + else + m_str = xstrdup ("keyword"); + } +}; + +struct a68_construct_format_token : public a68_format_token +{ +public: + a68_construct_format_token (a68_attribute a) + { + do_attr (a); + } + + a68_construct_format_token (NODE_T *p) + { + do_attr (ATTRIBUTE (p)); + } + +private: + + void do_attr (a68_attribute a) + { + const char *nt = a68_attribute_name (a); + if (nt != NO_TEXT) + m_str = xstrdup (nt); + else + m_str = xstrdup ("construct"); + } +}; + +struct a68_symbol_format_token : public a68_format_token +{ +public: + a68_symbol_format_token (NODE_T *p) + { + const char *txt = NSYMBOL (p); + char *sym = NCHAR_IN_LINE (p); + int n = 0, size = (int) strlen (txt); + + if (txt == NO_TEXT) + m_str = xstrdup ("symbol"); + else + { + if (txt[0] != sym[0] || (int) strlen (sym) < size) + m_str = xstrdup (txt); + else + { + m_str = (char *) xmalloc (size + 1); + while (n < size) + { + if (ISPRINT (sym[0])) + m_str[n] = sym[0]; + if (TOLOWER (txt[0]) == TOLOWER (sym[0])) + { + txt++; + n++; + } + sym++; + } + m_str[n] = '\0'; + } + } + } +}; + +struct a68_sort_format_token : public a68_format_token +{ +public: + a68_sort_format_token (int s) + { + const char *cstr; + switch (s) + { + case NO_SORT: cstr = "this"; break; + case SOFT: cstr = "a soft"; break; + case WEAK: cstr = "a weak"; break; + case MEEK: cstr = "a meek"; break; + case FIRM: cstr = "a firm"; break; + case STRONG: cstr = "a strong"; break; + default: + gcc_unreachable (); + } + m_str = xstrdup (cstr); + } +}; + + +struct a68_line_format_token : public a68_format_token +{ +public: + a68_line_format_token (LINE_T *l, NODE_T *n) + { + gcc_assert (l != NO_LINE); + if (NUMBER (l) == 0) + m_str = xstrdup ("in standard environment"); + else if (n != NO_NODE && NUMBER (l) == LINE_NUMBER (n)) + m_str = xstrdup ("in this line"); + else + { + m_str = (char *) xmalloc (18); + if (snprintf (m_str, 18, "in line %d", NUMBER (l)) < 0) + gcc_unreachable (); + } + } +}; + +#endif /* ! __A68_PRETTY_PRINT__ */ diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h index 66088efa3b2..f9c7d2e6292 100644 --- a/gcc/algol68/a68.h +++ b/gcc/algol68/a68.h @@ -270,13 +270,13 @@ MOID_T *a68_type_moid (tree type); /* a68-diagnostics.cc */ -void a68_error (NODE_T *p, const char *loc_str, ...); +void a68_error (NODE_T *p, const char *loc_str, ...) ATTRIBUTE_A68_DIAG(2,3); void a68_error_in_pragmat (NODE_T *p, size_t off, - const char *loc_str, ...); -bool a68_warning (NODE_T *p, int opt, const char *loc_str, ...); -void a68_inform (NODE_T *p, const char *loc_str, ...); -void a68_fatal (NODE_T *p, const char *loc_str, ...); -void a68_scan_error (LINE_T *u, char *v, const char *txt, ...); + const char *loc_str, ...) ATTRIBUTE_A68_DIAG(3,4); +bool a68_warning (NODE_T *p, int opt, const char *loc_str, ...) ATTRIBUTE_A68_DIAG(3,4); +void a68_inform (NODE_T *p, const char *loc_str, ...) ATTRIBUTE_A68_DIAG(2,3); +void a68_fatal (NODE_T *p, const char *loc_str, ...) ATTRIBUTE_A68_DIAG(2,3); +void a68_scan_error (LINE_T *u, char *v, const char *txt, ...) ATTRIBUTE_A68_DIAG(3,4); /* a68-parser-scanner.cc */ -- 2.39.5
