#include "diagnostic.h"
#include "a68.h"
+#include "a68-pretty-print.h"
/*
* Error handling routines.
#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)
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);
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;
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)
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;
}
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;
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;
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;
{
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_)
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));
}
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;
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;
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;
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;
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;
{
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;
}
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;
}
|| 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;
}
|| (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;
}
|| 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;
}
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;
}
*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;
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;
}
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;
}
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;
}
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;
}
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;
}
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;
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;
}
#include "options.h"
#include "a68.h"
+#include "a68-pretty-print.h"
+
+#include <string>
/* Give accurate error message. */
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++;
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 ();
}
}
}
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 ();
}
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 ();
}
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 ();
{
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);
+ }
}
}
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);
}
}
}
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);
}
#include "options.h"
#include "a68.h"
+#include "a68-pretty-print.h"
/* Bottom-up parser, reduces all constructs. */
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);
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
}
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);
}
}
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
}
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);
}
}
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:
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)
{
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);
+ }
}
}
}
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);
+ }
}
}
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);
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);
}
|| 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);
}
}
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,
#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.
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);
}
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");
}
}
#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.
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. */
&& 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;
}
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;
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;
}
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);
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);
}
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;
}
}
#include "coretypes.h"
#include "a68.h"
+#include "a68-pretty-print.h"
/*
* Mode collection, equivalencing and derived modes.
/* 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);
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
{
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;
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))
{
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);
+ }
}
}
}
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);
+ }
}
}
}
{
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;
}
}
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);
+ }
}
}
#include "options.h"
#include "a68.h"
+#include "a68-pretty-print.h"
/* Forward declarations of some of the functions defined below. */
{
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))
}
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;
}
}
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);
}
}
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
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
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);
}
}
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
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)
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;
}
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)
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);
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);
+ }
}
}
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);. */
}
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);
}
}
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);
}
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
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;
}
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;
}
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);
}
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
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;
}
}
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);
}
{
/* 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)))
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;
}
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;
}
else
{
a68_error_in_pragmat (p, pragmat - NPRAGMAT (p),
- "unrecognized pragmat Z", word);
+ "unrecognized pragmat %qs", word);
break;
}
}
#include "vec.h"
#include "a68.h"
+#include "a68-pretty-print.h"
/* A few forward references of static functions defined in this file. */
}
SCAN_ERROR (c != ',', *start_l, *ref_s,
- "expected , or ) in string break");
+ "expected %<,%> or %<)%> in string break");
}
else
{
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. */
#include "options.h"
#include "a68.h"
+#include "a68-pretty-print.h"
struct TUPLE_T
{
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++;
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));
}
}
#include "options.h"
#include "a68.h"
+#include "a68-pretty-print.h"
/*
* Symbol table handling, managing TAGS.
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;
}
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
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. */
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));
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);
}
}
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)));
}
}
&& (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;
#include "coretypes.h"
#include "a68.h"
+#include "a68-pretty-print.h"
/* A few forward prototypes of functions defined below. */
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. */
{
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);
}
}
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. */
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. */
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");
}
}
}
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));
}
}
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));
}
}
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));
}
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;
}
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;
}
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))
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
{
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));
}
}
--- /dev/null
+/* 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__ */
/* 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 */
projects / thirdparty / gcc.git / commitdiff
