a68g-diagnostics.c
1 //! @file a68g-diagnostics.c
2 //! @author J. Marcel van der Veer
3
4 //! @section Copyright
5 //!
6 //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
7 //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
8
9 //! @section License
10 //!
11 //! This program is free software; you can redistribute it and/or modify it
12 //! under the terms of the GNU General Public License as published by the
13 //! Free Software Foundation; either version 3 of the License, or
14 //! (at your option) any later version.
15 //!
16 //! This program is distributed in the hope that it will be useful, but
17 //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 //! more details. You should have received a copy of the GNU General Public
20 //! License along with this program. If not, see [http://www.gnu.org/licenses/].
21
22 //! @section Synopsis
23 //!
24 //! Error and warning routines.
25
26 #include "a68g.h"
27 #include "a68g-prelude.h"
28 #include "a68g-transput.h"
29 #include "a68g-parser.h"
30
31 // Error handling routines.
32
33 #define TABULATE(n) (8 * (n / 8 + 1) - n)
34
35 //! @brief Return error test from errno.
36
37 char *error_specification (void)
38 {
39 static BUFFER txt;
40 if (errno == 0) {
41 ASSERT (snprintf (txt, SNPRINTF_SIZE, "no information") >= 0);
42 } else {
43 ASSERT (snprintf (txt, SNPRINTF_SIZE, "%s", strerror (errno)) >= 0);
44 }
45 if (strlen (txt) > 0) {
46 txt[0] = TO_LOWER (txt[0]);
47 }
48 return txt;
49 }
50
51 //! @brief Whether unprintable control character.
52
53 BOOL_T unprintable (char ch)
54 {
55 return (BOOL_T) (!IS_PRINT (ch) && ch != TAB_CHAR);
56 }
57
58 //! @brief Format for printing control character.
59
60 char *ctrl_char (int ch)
61 {
62 static char txt[SMALL_BUFFER_SIZE];
63 ch = TO_UCHAR (ch);
64 if (IS_CNTRL (ch) && IS_LOWER (ch + 96)) {
65 ASSERT (snprintf (txt, (size_t) SMALL_BUFFER_SIZE, "\\^%c", ch + 96) >= 0);
66 } else {
67 ASSERT (snprintf (txt, (size_t) SMALL_BUFFER_SIZE, "\\%02x", (unt) ch) >= 0);
68 }
69 return txt;
70 }
71
72 //! @brief Widen single char to string.
73
74 char *char_to_str (char ch)
75 {
76 static char txt[2];
77 txt[0] = ch;
78 txt[1] = NULL_CHAR;
79 return txt;
80 }
81
82 //! @brief Pretty-print diagnostic.
83
84 void pretty_diag (FILE_T f, char *p)
85 {
86 int line_width = (f == A68_STDOUT ? A68 (term_width) : MAX_TERM_WIDTH);
87 int pos = 1;
88 while (p[0] != NULL_CHAR) {
89 char *q;
90 int k;
91 // Count the number of characters in token to print.
92 if (IS_GRAPH (p[0])) {
93 for (k = 0, q = p; q[0] != BLANK_CHAR && q[0] != NULL_CHAR && k <= line_width; q++, k++) {
94 ;
95 }
96 } else {
97 k = 1;
98 }
99 // Now see if there is space for the token.
100 if (k > line_width) {
101 k = 1;
102 }
103 if ((pos + k) >= line_width) {
104 WRITE (f, NEWLINE_STRING);
105 pos = 1;
106 }
107 for (; k > 0; k--, p++, pos++) {
108 WRITE (f, char_to_str (p[0]));
109 }
110 }
111 for (; p[0] == BLANK_CHAR; p++, pos++) {
112 WRITE (f, char_to_str (p[0]));
113 }
114 }
115
116 //! @brief Abnormal end.
117
118 void abend (char *reason, char *info, char *file, int line)
119 {
120 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "%s: exiting: %s: %d: %s", A68 (a68_cmd_name), file, line, reason) >= 0);
121 if (info != NO_TEXT) {
122 bufcat (A68 (output_line), ", ", BUFFER_SIZE);
123 bufcat (A68 (output_line), info, BUFFER_SIZE);
124 }
125 if (errno != 0) {
126 bufcat (A68 (output_line), " (", BUFFER_SIZE);
127 bufcat (A68 (output_line), error_specification (), BUFFER_SIZE);
128 bufcat (A68 (output_line), ")", BUFFER_SIZE);
129 }
130 bufcat (A68 (output_line), "\n", BUFFER_SIZE);
131 io_close_tty_line ();
132 pretty_diag (A68_STDOUT, A68 (output_line));
133 a68_exit (EXIT_FAILURE);
134 }
135
136 //! @brief Position in line .
137
138 char *where_pos (LINE_T * p, NODE_T * q)
139 {
140 char *pos;
141 if (q != NO_NODE && p == LINE (INFO (q))) {
142 pos = CHAR_IN_LINE (INFO (q));
143 } else {
144 pos = STRING (p);
145 }
146 if (pos == NO_TEXT) {
147 pos = STRING (p);
148 }
149 for (; IS_SPACE (pos[0]) && pos[0] != NULL_CHAR; pos++) {
150 ;
151 }
152 if (pos[0] == NULL_CHAR) {
153 pos = STRING (p);
154 }
155 return pos;
156 }
157
158 //! @brief Position in line where diagnostic points at.
159
160 char *diag_pos (LINE_T * p, DIAGNOSTIC_T * d)
161 {
162 char *pos;
163 if (WHERE (d) != NO_NODE && p == LINE (INFO (WHERE (d)))) {
164 pos = CHAR_IN_LINE (INFO (WHERE (d)));
165 } else {
166 pos = STRING (p);
167 }
168 if (pos == NO_TEXT) {
169 pos = STRING (p);
170 }
171 for (; IS_SPACE (pos[0]) && pos[0] != NULL_CHAR; pos++) {
172 ;
173 }
174 if (pos[0] == NULL_CHAR) {
175 pos = STRING (p);
176 }
177 return pos;
178 }
179
180 //! @brief Write source line to file with diagnostics.
181
182 void write_source_line (FILE_T f, LINE_T * p, NODE_T * nwhere, int mask)
183 {
184 int line_width = (f == A68_STDOUT ? A68 (term_width) : MAX_TERM_WIDTH);
185 // Terminate properly.
186 if ((STRING (p))[strlen (STRING (p)) - 1] == NEWLINE_CHAR) {
187 (STRING (p))[strlen (STRING (p)) - 1] = NULL_CHAR;
188 if ((STRING (p))[strlen (STRING (p)) - 1] == CR_CHAR) {
189 (STRING (p))[strlen (STRING (p)) - 1] = NULL_CHAR;
190 }
191 }
192 // Print line number.
193 if (f == A68_STDOUT) {
194 io_close_tty_line ();
195 } else {
196 WRITE (f, NEWLINE_STRING);
197 }
198 if (NUMBER (p) == 0) {
199 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, " ") >= 0);
200 } else {
201 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "%-5d ", NUMBER (p) % 100000) >= 0);
202 }
203 WRITE (f, A68 (output_line));
204 // Pretty print line.
205 char *c, *c0;
206 c = c0 = STRING (p);
207 int pos = 5, col = 1;
208 int continuations = 0;
209 BOOL_T line_ended = A68_FALSE;
210 while (!line_ended) {
211 int len = 0;
212 char *new_pos = NO_TEXT;
213 if (c[0] == NULL_CHAR) {
214 bufcpy (A68 (output_line), "", BUFFER_SIZE);
215 line_ended = A68_TRUE;
216 } else {
217 if (IS_GRAPH (c[0])) {
218 char *c1;
219 bufcpy (A68 (output_line), "", BUFFER_SIZE);
220 for (c1 = c; IS_GRAPH (c1[0]) && len <= line_width - 5; c1++, len++) {
221 bufcat (A68 (output_line), char_to_str (c1[0]), BUFFER_SIZE);
222 }
223 if (len > line_width - 5) {
224 bufcpy (A68 (output_line), char_to_str (c[0]), BUFFER_SIZE);
225 len = 1;
226 }
227 new_pos = &c[len];
228 col += len;
229 } else if (c[0] == TAB_CHAR) {
230 int n = TABULATE (col);
231 len = n;
232 col += n;
233 bufcpy (A68 (output_line), "", BUFFER_SIZE);
234 while (n--) {
235 bufcat (A68 (output_line), " ", BUFFER_SIZE);
236 }
237 new_pos = &c[1];
238 } else if (unprintable (c[0])) {
239 bufcpy (A68 (output_line), ctrl_char ((int) c[0]), BUFFER_SIZE);
240 len = (int) strlen (A68 (output_line));
241 new_pos = &c[1];
242 col++;
243 } else {
244 bufcpy (A68 (output_line), char_to_str (c[0]), BUFFER_SIZE);
245 len = 1;
246 new_pos = &c[1];
247 col++;
248 }
249 }
250 if (!line_ended && (pos + len) <= line_width) {
251 // Still room - print a character.
252 WRITE (f, A68 (output_line));
253 pos += len;
254 c = new_pos;
255 } else {
256 // First see if there are diagnostics to be printed.
257 BOOL_T y = A68_FALSE, z = A68_FALSE;
258 DIAGNOSTIC_T *d = DIAGNOSTICS (p);
259 if (d != NO_DIAGNOSTIC || nwhere != NO_NODE) {
260 char *c1;
261 for (c1 = c0; c1 != c; c1++) {
262 y |= (BOOL_T) (nwhere != NO_NODE && p == LINE (INFO (nwhere)) ? c1 == where_pos (p, nwhere) : A68_FALSE);
263 if (mask != A68_NO_DIAGNOSTICS) {
264 for (d = DIAGNOSTICS (p); d != NO_DIAGNOSTIC; FORWARD (d)) {
265 z = (BOOL_T) (z | (c1 == diag_pos (p, d)));
266 }
267 }
268 }
269 }
270 // If diagnostics are to be printed then print marks.
271 if (y || z) {
272 DIAGNOSTIC_T *d2;
273 char *c1;
274 int col_2 = 1;
275 WRITE (f, "\n ");
276 for (c1 = c0; c1 != c; c1++) {
277 int k = 0, diags_at_this_pos = 0;
278 for (d2 = DIAGNOSTICS (p); d2 != NO_DIAGNOSTIC; FORWARD (d2)) {
279 if (c1 == diag_pos (p, d2)) {
280 diags_at_this_pos++;
281 k = NUMBER (d2);
282 }
283 }
284 if (y == A68_TRUE && c1 == where_pos (p, nwhere)) {
285 bufcpy (A68 (output_line), "-", BUFFER_SIZE);
286 } else if (diags_at_this_pos != 0) {
287 if (mask == A68_NO_DIAGNOSTICS) {
288 bufcpy (A68 (output_line), " ", BUFFER_SIZE);
289 } else if (diags_at_this_pos == 1) {
290 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "%c", digchar (k)) >= 0);
291 } else {
292 bufcpy (A68 (output_line), "*", BUFFER_SIZE);
293 }
294 } else {
295 if (unprintable (c1[0])) {
296 int n = (int) strlen (ctrl_char (c1[0]));
297 col_2 += 1;
298 bufcpy (A68 (output_line), "", BUFFER_SIZE);
299 while (n--) {
300 bufcat (A68 (output_line), " ", BUFFER_SIZE);
301 }
302 } else if (c1[0] == TAB_CHAR) {
303 int n = TABULATE (col_2);
304 col_2 += n;
305 bufcpy (A68 (output_line), "", BUFFER_SIZE);
306 while (n--) {
307 bufcat (A68 (output_line), " ", BUFFER_SIZE);
308 }
309 } else {
310 bufcpy (A68 (output_line), " ", BUFFER_SIZE);
311 col_2++;
312 }
313 }
314 WRITE (f, A68 (output_line));
315 }
316 }
317 // Resume pretty printing of line.
318 if (!line_ended) {
319 continuations++;
320 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "\n.%1d ", continuations) >= 0);
321 WRITE (f, A68 (output_line));
322 if (continuations >= 9) {
323 WRITE (f, "...");
324 line_ended = A68_TRUE;
325 } else {
326 c0 = c;
327 pos = 5;
328 col = 1;
329 }
330 }
331 }
332 }
333 // Print the diagnostics.
334 if (mask) {
335 if (DIAGNOSTICS (p) != NO_DIAGNOSTIC) {
336 DIAGNOSTIC_T *d;
337 for (d = DIAGNOSTICS (p); d != NO_DIAGNOSTIC; FORWARD (d)) {
338 if (mask == A68_RUNTIME_ERROR) {
339 if (IS (d, A68_RUNTIME_ERROR) || IS (d, A68_MATH_ERROR) || (IS (d, A68_MATH_WARNING))) {
340 WRITE (f, NEWLINE_STRING);
341 pretty_diag (f, TEXT (d));
342 }
343 } else {
344 WRITE (f, NEWLINE_STRING);
345 pretty_diag (f, TEXT (d));
346 }
347 }
348 }
349 }
350 }
351
352 //! @brief Write diagnostics to STDOUT.
353
354 void diagnostics_to_terminal (LINE_T * p, int sev)
355 {
356 for (; p != NO_LINE; FORWARD (p)) {
357 if (DIAGNOSTICS (p) != NO_DIAGNOSTIC) {
358 BOOL_T z = A68_FALSE;
359 for (DIAGNOSTIC_T *d = DIAGNOSTICS (p); d != NO_DIAGNOSTIC; FORWARD (d)) {
360 if (sev == A68_ALL_DIAGNOSTICS) {
361 z = (BOOL_T) (z | (IS (d, A68_WARNING) || IS (d, A68_ERROR) || IS (d, A68_SYNTAX_ERROR) || IS (d, A68_MATH_ERROR) || IS (d, A68_RUNTIME_ERROR) || IS (d, A68_SUPPRESS_SEVERITY)));
362 } else if (sev == A68_RUNTIME_ERROR) {
363 z = (BOOL_T) (z | (IS (d, A68_RUNTIME_ERROR) || (IS (d, A68_MATH_ERROR))));
364 }
365 }
366 if (z) {
367 write_source_line (A68_STDOUT, p, NO_NODE, sev);
368 }
369 }
370 }
371 }
372
373 //! @brief Give an intelligible error and exit.
374
375 void scan_error (LINE_T * u, char *v, char *txt)
376 {
377 if (errno != 0) {
378 diagnostic (A68_SUPPRESS_SEVERITY, NO_NODE, txt, u, v, error_specification ());
379 } else {
380 diagnostic (A68_SUPPRESS_SEVERITY, NO_NODE, txt, u, v, ERROR_UNSPECIFIED);
381 }
382 longjmp (RENDEZ_VOUS (&A68_JOB), 1);
383 }
384
385 //! @brief Give an intelligible warning.
386
387 void scan_warning (LINE_T * u, char *v, char *txt)
388 {
389 if (errno != 0) {
390 diagnostic (A68_SUPPRESS_SEVERITY, NO_NODE, txt, u, v, error_specification ());
391 } else {
392 diagnostic (A68_SUPPRESS_SEVERITY, NO_NODE, txt, u, v, ERROR_UNSPECIFIED);
393 }
394 }
395
396 //! @brief Get severity text.
397
398 char *get_severity (int sev)
399 {
400 switch (sev) {
401 case A68_ERROR: {
402 return "error";
403 }
404 case A68_SYNTAX_ERROR: {
405 return "syntax error";
406 }
407 case A68_RUNTIME_ERROR: {
408 return "runtime error";
409 }
410 case A68_MATH_ERROR: {
411 return "math error";
412 }
413 case A68_MATH_WARNING: {
414 return "math warning";
415 }
416 case A68_WARNING: {
417 return "warning";
418 }
419 case A68_SUPPRESS_SEVERITY: {
420 return NO_TEXT;
421 }
422 default: {
423 return NO_TEXT;
424 }
425 }
426 }
427
428 //! @brief Print diagnostic.
429
430 void write_diagnostic (int sev, char *b)
431 {
432 char txt[SMALL_BUFFER_SIZE];
433 char *severity = get_severity (sev);
434 if (severity == NO_TEXT) {
435 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "%s: %s.", A68 (a68_cmd_name), b) >= 0);
436 } else {
437 bufcpy (txt, get_severity (sev), SMALL_BUFFER_SIZE);
438 ASSERT (snprintf (A68 (output_line), SNPRINTF_SIZE, "%s: %s: %s.", A68 (a68_cmd_name), txt, b) >= 0);
439 }
440 io_close_tty_line ();
441 pretty_diag (A68_STDOUT, A68 (output_line));
442 }
443
444 //! @brief Add diagnostic to source line.
445
446 void add_diagnostic (LINE_T * line, char *pos, NODE_T * p, int sev, char *b)
447 {
448 // Add diagnostic and choose GNU style or non-GNU style.
449 DIAGNOSTIC_T *msg = (DIAGNOSTIC_T *) get_heap_space ((size_t) SIZE_ALIGNED (DIAGNOSTIC_T));
450 DIAGNOSTIC_T **ref_msg;
451 BUFFER a, nst;
452 char st[SMALL_BUFFER_SIZE];
453 char *severity = get_severity (sev);
454 int k = 1;
455 if (line == NO_LINE && p == NO_NODE) {
456 return;
457 }
458 if (A68 (in_monitor)) {
459 monitor_error (b, NO_TEXT);
460 return;
461 }
462 nst[0] = NULL_CHAR;
463 if (line == NO_LINE && p != NO_NODE) {
464 line = LINE (INFO (p));
465 }
466 while (line != NO_LINE && NUMBER (line) == 0) {
467 FORWARD (line);
468 }
469 if (line == NO_LINE) {
470 return;
471 }
472 ref_msg = &(DIAGNOSTICS (line));
473 while (*ref_msg != NO_DIAGNOSTIC) {
474 ref_msg = &(NEXT (*ref_msg));
475 k++;
476 }
477 if (p != NO_NODE) {
478 NODE_T *n = NEST (p);
479 if (n != NO_NODE && NSYMBOL (n) != NO_TEXT) {
480 char *nt = non_terminal_string (A68 (edit_line), ATTRIBUTE (n));
481 if (nt != NO_TEXT) {
482 if (LINE_NUMBER (n) == 0) {
483 ASSERT (snprintf (nst, SNPRINTF_SIZE, ", in %s", nt) >= 0);
484 } else {
485 if (MOID (n) != NO_MOID) {
486 if (LINE_NUMBER (n) == NUMBER (line)) {
487 ASSERT (snprintf (nst, SNPRINTF_SIZE, ", in %s %s starting at \"%.64s\" in this line", moid_to_string (MOID (n), MOID_ERROR_WIDTH, p), nt, NSYMBOL (n)) >= 0);
488 } else {
489 ASSERT (snprintf (nst, SNPRINTF_SIZE, ", in %s %s starting at \"%.64s\" in line %d", moid_to_string (MOID (n), MOID_ERROR_WIDTH, p), nt, NSYMBOL (n), LINE_NUMBER (n)) >= 0);
490 }
491 } else {
492 if (LINE_NUMBER (n) == NUMBER (line)) {
493 ASSERT (snprintf (nst, SNPRINTF_SIZE, ", in %s starting at \"%.64s\" in this line", nt, NSYMBOL (n)) >= 0);
494 } else {
495 ASSERT (snprintf (nst, SNPRINTF_SIZE, ", in %s starting at \"%.64s\" in line %d", nt, NSYMBOL (n), LINE_NUMBER (n)) >= 0);
496 }
497 }
498 }
499 }
500 }
501 }
502 if (severity == NO_TEXT) {
503 if (FILENAME (line) != NO_TEXT && strcmp (FILE_SOURCE_NAME (&A68_JOB), FILENAME (line)) == 0) {
504 ASSERT (snprintf (a, SNPRINTF_SIZE, "%s: %x: %s", A68 (a68_cmd_name), (unt) k, b) >= 0);
505 } else if (FILENAME (line) != NO_TEXT) {
506 ASSERT (snprintf (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68 (a68_cmd_name), FILENAME (line), (unt) k, b) >= 0);
507 } else {
508 ASSERT (snprintf (a, SNPRINTF_SIZE, "%s: %x: %s", A68 (a68_cmd_name), (unt) k, b) >= 0);
509 }
510 } else {
511 bufcpy (st, get_severity (sev), SMALL_BUFFER_SIZE);
512 if (FILENAME (line) != NO_TEXT && strcmp (FILE_SOURCE_NAME (&A68_JOB), FILENAME (line)) == 0) {
513 ASSERT (snprintf (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68 (a68_cmd_name), st, (unt) k, b) >= 0);
514 } else if (FILENAME (line) != NO_TEXT) {
515 ASSERT (snprintf (a, SNPRINTF_SIZE, "%s: %s: %s: %x: %s", A68 (a68_cmd_name), FILENAME (line), st, (unt) k, b) >= 0);
516 } else {
517 ASSERT (snprintf (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68 (a68_cmd_name), st, (unt) k, b) >= 0);
518 }
519 }
520 // cppcheck might complain here but this memory is not returned, for obvious reasons.
521 *ref_msg = msg;
522 ATTRIBUTE (msg) = sev;
523 if (nst[0] != NULL_CHAR) {
524 bufcat (a, nst, BUFFER_SIZE);
525 }
526 bufcat (a, ".", BUFFER_SIZE);
527 TEXT (msg) = new_string (a, NO_TEXT);
528 WHERE (msg) = p;
529 LINE (msg) = line;
530 SYMBOL (msg) = pos;
531 NUMBER (msg) = k;
532 NEXT (msg) = NO_DIAGNOSTIC;
533 }
534
535 //! @brief Give a diagnostic message.
536
537 void diagnostic (STATUS_MASK_T sev, NODE_T * p, char *loc_str, ...)
538 {
539 va_list args;
540 MOID_T *moid = NO_MOID;
541 char *t = loc_str, b[BUFFER_SIZE];
542 BOOL_T force, extra_syntax = A68_TRUE, compose = A68_TRUE, issue = A68_TRUE;
543 va_start (args, loc_str);
544 (void) extra_syntax;
545 b[0] = NULL_CHAR;
546 force = (BOOL_T) ((sev & A68_FORCE_DIAGNOSTICS) != 0);
547 sev &= ~A68_FORCE_DIAGNOSTICS;
548 // Node or line?
549 LINE_T *line = NO_LINE;
550 char *pos = NO_TEXT;
551 if (p == NO_NODE) {
552 line = va_arg (args, LINE_T *);
553 pos = va_arg (args, char *);
554 }
555 // No warnings?
556 if (!force && sev == A68_WARNING && OPTION_NO_WARNINGS (&A68_JOB)) {
557 va_end (args);
558 return;
559 }
560 if (!force && sev == A68_MATH_WARNING && OPTION_NO_WARNINGS (&A68_JOB)) {
561 va_end (args);
562 return;
563 }
564 if (sev == A68_WARNING && OPTION_QUIET (&A68_JOB)) {
565 va_end (args);
566 return;
567 }
568 if (sev == A68_MATH_WARNING && OPTION_QUIET (&A68_JOB)) {
569 va_end (args);
570 return;
571 }
572 // Suppressed?.
573 if (sev == A68_ERROR || sev == A68_SYNTAX_ERROR) {
574 if (ERROR_COUNT (&A68_JOB) == MAX_ERRORS) {
575 bufcpy (b, "further diagnostics suppressed", BUFFER_SIZE);
576 compose = A68_FALSE;
577 sev = A68_ERROR;
578 } else if (ERROR_COUNT (&A68_JOB) > MAX_ERRORS) {
579 ERROR_COUNT (&A68_JOB)++;
580 compose = issue = A68_FALSE;
581 }
582 } else if (sev == A68_WARNING || sev == A68_MATH_WARNING) {
583 if (WARNING_COUNT (&A68_JOB) == MAX_ERRORS) {
584 bufcpy (b, "further diagnostics suppressed", BUFFER_SIZE);
585 compose = A68_FALSE;
586 } else if (WARNING_COUNT (&A68_JOB) > MAX_ERRORS) {
587 WARNING_COUNT (&A68_JOB)++;
588 compose = issue = A68_FALSE;
589 }
590 }
591 if (compose) {
592 // Synthesize diagnostic message.
593 if ((sev & A68_NO_SYNTHESIS) != NULL_MASK) {
594 sev &= ~A68_NO_SYNTHESIS;
595 bufcat (b, t, BUFFER_SIZE);
596 } else {
597 // Legend for special symbols:
598 // * as first character, copy rest of string literally
599 // # skip extra syntactical information
600 // @ non terminal
601 // A non terminal
602 // B keyword
603 // C context
604 // D argument in decimal
605 // H char argument
606 // K 'LONG'
607 // L line number
608 // M moid - if error mode return without giving a message
609 // N mode - M_NIL
610 // O moid - operand
611 // S quoted symbol, when possible with typographical display features
612 // X expected attribute
613 // Y string literal.
614 // Z quoted string literal.
615 if (t[0] == '*') {
616 bufcat (b, &t[1], BUFFER_SIZE);
617 } else
618 while (t[0] != NULL_CHAR) {
619 if (t[0] == '#') {
620 extra_syntax = A68_FALSE;
621 } else if (t[0] == '@') {
622 char *nt = non_terminal_string (A68 (edit_line), ATTRIBUTE (p));
623 if (t != NO_TEXT) {
624 bufcat (b, nt, BUFFER_SIZE);
625 } else {
626 bufcat (b, "construct", BUFFER_SIZE);
627 }
628 } else if (t[0] == 'A') {
629 int att = va_arg (args, int);
630 char *nt = non_terminal_string (A68 (edit_line), att);
631 if (nt != NO_TEXT) {
632 bufcat (b, nt, BUFFER_SIZE);
633 } else {
634 bufcat (b, "construct", BUFFER_SIZE);
635 }
636 } else if (t[0] == 'B') {
637 int att = va_arg (args, int);
638 KEYWORD_T *nt = find_keyword_from_attribute (A68 (top_keyword), att);
639 if (nt != NO_KEYWORD) {
640 bufcat (b, "\"", BUFFER_SIZE);
641 bufcat (b, TEXT (nt), BUFFER_SIZE);
642 bufcat (b, "\"", BUFFER_SIZE);
643 } else {
644 bufcat (b, "keyword", BUFFER_SIZE);
645 }
646 } else if (t[0] == 'C') {
647 int att = va_arg (args, int);
648 if (att == NO_SORT) {
649 bufcat (b, "this", BUFFER_SIZE);
650 }
651 if (att == SOFT) {
652 bufcat (b, "a soft", BUFFER_SIZE);
653 } else if (att == WEAK) {
654 bufcat (b, "a weak", BUFFER_SIZE);
655 } else if (att == MEEK) {
656 bufcat (b, "a meek", BUFFER_SIZE);
657 } else if (att == FIRM) {
658 bufcat (b, "a firm", BUFFER_SIZE);
659 } else if (att == STRONG) {
660 bufcat (b, "a strong", BUFFER_SIZE);
661 }
662 } else if (t[0] == 'D') {
663 int a = va_arg (args, int);
664 BUFFER d;
665 BUFCLR (d);
666 ASSERT (snprintf (d, SNPRINTF_SIZE, "%d", a) >= 0);
667 bufcat (b, d, BUFFER_SIZE);
668 } else if (t[0] == 'H') {
669 char *a = va_arg (args, char *);
670 char d[SMALL_BUFFER_SIZE];
671 ASSERT (snprintf (d, (size_t) SMALL_BUFFER_SIZE, "\"%c\"", a[0]) >= 0);
672 bufcat (b, d, BUFFER_SIZE);
673 } else if (t[0] == 'K') {
674 bufcat (b, "LONG", BUFFER_SIZE);
675 } else if (t[0] == 'L') {
676 LINE_T *a = va_arg (args, LINE_T *);
677 char d[SMALL_BUFFER_SIZE];
678 ABEND (a == NO_LINE, ERROR_INTERNAL_CONSISTENCY, __func__);
679 if (NUMBER (a) == 0) {
680 bufcat (b, "in standard environment", BUFFER_SIZE);
681 } else {
682 if (p != NO_NODE && NUMBER (a) == LINE_NUMBER (p)) {
683 ASSERT (snprintf (d, (size_t) SMALL_BUFFER_SIZE, "in this line") >= 0);
684 } else {
685 ASSERT (snprintf (d, (size_t) SMALL_BUFFER_SIZE, "in line %d", NUMBER (a)) >= 0);
686 }
687 bufcat (b, d, BUFFER_SIZE);
688 }
689 } else if (t[0] == 'M') {
690 moid = va_arg (args, MOID_T *);
691 if (moid == NO_MOID || moid == M_ERROR) {
692 moid = M_UNDEFINED;
693 }
694 if (IS (moid, SERIES_MODE)) {
695 if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) {
696 bufcat (b, moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE);
697 } else {
698 bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
699 }
700 } else {
701 bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
702 }
703 } else if (t[0] == 'N') {
704 bufcat (b, "NIL name of mode ", BUFFER_SIZE);
705 moid = va_arg (args, MOID_T *);
706 if (moid != NO_MOID) {
707 bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
708 }
709 } else if (t[0] == 'O') {
710 moid = va_arg (args, MOID_T *);
711 if (moid == NO_MOID || moid == M_ERROR) {
712 moid = M_UNDEFINED;
713 }
714 if (moid == M_VOID) {
715 bufcat (b, "UNION (VOID, ..)", BUFFER_SIZE);
716 } else if (IS (moid, SERIES_MODE)) {
717 if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) {
718 bufcat (b, moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE);
719 } else {
720 bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
721 }
722 } else {
723 bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
724 }
725 } else if (t[0] == 'S') {
726 if (p != NO_NODE && NSYMBOL (p) != NO_TEXT) {
727 char *txt = NSYMBOL (p);
728 char *sym = NCHAR_IN_LINE (p);
729 int n = 0, size = (int) strlen (txt);
730 bufcat (b, "\"", BUFFER_SIZE);
731 if (txt[0] != sym[0] || (int) strlen (sym) < size) {
732 bufcat (b, txt, BUFFER_SIZE);
733 } else {
734 while (n < size) {
735 if (IS_PRINT (sym[0])) {
736 char str[2];
737 str[0] = sym[0];
738 str[1] = NULL_CHAR;
739 bufcat (b, str, BUFFER_SIZE);
740 }
741 if (TO_LOWER (txt[0]) == TO_LOWER (sym[0])) {
742 txt++;
743 n++;
744 }
745 sym++;
746 }
747 }
748 bufcat (b, "\"", BUFFER_SIZE);
749 } else {
750 bufcat (b, "symbol", BUFFER_SIZE);
751 }
752 } else if (t[0] == 'V') {
753 bufcat (b, PACKAGE_STRING, BUFFER_SIZE);
754 } else if (t[0] == 'X') {
755 int att = va_arg (args, int);
756 BUFFER z;
757 (void) non_terminal_string (z, att);
758 bufcat (b, new_string (z, NO_TEXT), BUFFER_SIZE);
759 } else if (t[0] == 'Y') {
760 char *loc_string = va_arg (args, char *);
761 bufcat (b, loc_string, BUFFER_SIZE);
762 } else if (t[0] == 'Z') {
763 char *loc_string = va_arg (args, char *);
764 bufcat (b, "\"", BUFFER_SIZE);
765 bufcat (b, loc_string, BUFFER_SIZE);
766 bufcat (b, "\"", BUFFER_SIZE);
767 } else {
768 char q[2];
769 q[0] = t[0];
770 q[1] = NULL_CHAR;
771 bufcat (b, q, BUFFER_SIZE);
772 }
773 t++;
774 }
775 // Add information from errno, if any.
776 if (errno != 0) {
777 char *loc_str2 = new_string (error_specification (), NO_TEXT);
778 if (loc_str2 != NO_TEXT) {
779 char *stu;
780 bufcat (b, ", ", BUFFER_SIZE);
781 for (stu = loc_str2; stu[0] != NULL_CHAR; stu++) {
782 stu[0] = (char) TO_LOWER (stu[0]);
783 }
784 bufcat (b, loc_str2, BUFFER_SIZE);
785 }
786 }
787 }
788 }
789 // Construct a diagnostic message.
790 if (issue) {
791 if (sev == A68_WARNING) {
792 WARNING_COUNT (&A68_JOB)++;
793 } else {
794 ERROR_COUNT (&A68_JOB)++;
795 }
796 if (p == NO_NODE) {
797 if (line == NO_LINE) {
798 write_diagnostic (sev, b);
799 } else {
800 add_diagnostic (line, pos, NO_NODE, sev, b);
801 }
802 } else {
803 add_diagnostic (NO_LINE, NO_TEXT, p, sev, b);
804 if (sev == A68_MATH_WARNING && p != NO_NODE && LINE (INFO (p)) != NO_LINE) {
805 write_source_line (A68_STDOUT, LINE (INFO (p)), p, A68_TRUE);
806 WRITE (A68_STDOUT, NEWLINE_STRING);
807 }
808 }
809 }
810 va_end (args);
811 }
