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-2026 J. Marcel van der Veer [algol68g@algol68genie.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 (a68g_bufprt (txt, SNPRINTF_SIZE, "no information") >= 0);
42 } else {
43 ASSERT (a68g_bufprt (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 (a68g_bufprt (txt, (size_t) SMALL_BUFFER_SIZE, "\\^%c", ch + 96) >= 0);
66 } else {
67 ASSERT (a68g_bufprt (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 == A68G_STDERR || f == A68G_STDOUT ? A68G (term_width) : MAX_TERM_WIDTH);
87 int pos = 1;
88 while (p[0] != NULL_CHAR) {
89 int k;
90 // Count the number of characters in token to print.
91 if (IS_GRAPH (p[0])) {
92 char *q;
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 *func)
119 {
120 #if defined (BUILD_WINDOWS)
121 printf_s ("%s: abend: %s.\n", A68G (a68g_cmd_name), reason);
122 #else
123 if (func == NO_TEXT) {
124 if (info == NO_TEXT) {
125 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: abend: %s.", A68G (a68g_cmd_name), reason) >= 0);
126 } else {
127 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: abend: %s (%s).", A68G (a68g_cmd_name), reason, info) >= 0);
128 }
129 } else {
130 if (info == NO_TEXT) {
131 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: abend: %s (%s).", A68G (a68g_cmd_name), reason, func) >= 0);
132 } else {
133 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: abend: %s (%s, %s).", A68G (a68g_cmd_name), reason, info, func) >= 0);
134 }
135 }
136 io_close_tty_line ();
137 pretty_diag (A68G_STDERR, A68G (output_line));
138 #endif
139 a68g_exit (EXIT_FAILURE);
140 }
141
142 //! @brief Position in line .
143
144 char *where_pos (LINE_T * p, NODE_T * q)
145 {
146 char *pos;
147 if (q != NO_NODE && p == LINE (INFO (q))) {
148 pos = CHAR_IN_LINE (INFO (q));
149 } else {
150 pos = STRING (p);
151 }
152 if (pos == NO_TEXT) {
153 pos = STRING (p);
154 }
155 for (; IS_SPACE (pos[0]) && pos[0] != NULL_CHAR; pos++) {
156 ;
157 }
158 if (pos[0] == NULL_CHAR) {
159 pos = STRING (p);
160 }
161 return pos;
162 }
163
164 //! @brief Position in line where diagnostic points at.
165
166 char *diag_pos (LINE_T * p, DIAGNOSTIC_T * d)
167 {
168 char *pos;
169 if (WHERE (d) != NO_NODE && p == LINE (INFO (WHERE (d)))) {
170 pos = CHAR_IN_LINE (INFO (WHERE (d)));
171 } else {
172 pos = STRING (p);
173 }
174 if (pos == NO_TEXT) {
175 pos = STRING (p);
176 }
177 for (; IS_SPACE (pos[0]) && pos[0] != NULL_CHAR; pos++) {
178 ;
179 }
180 if (pos[0] == NULL_CHAR) {
181 pos = STRING (p);
182 }
183 return pos;
184 }
185
186 //! @brief Write source line to file with diagnostics.
187
188 void write_source_line (FILE_T f, LINE_T * p, NODE_T * nwhere, int mask)
189 {
190 int line_width = (f == A68G_STDERR || f == A68G_STDOUT ? A68G (term_width) : MAX_TERM_WIDTH);
191 // Terminate properly.
192 size_t len = strlen (STRING (p));
193 if (len > 0 && (STRING (p))[len - 1] == NEWLINE_CHAR) {
194 (STRING (p))[len - 1] = NULL_CHAR;
195 }
196 len = strlen (STRING (p));
197 if (len > 0 && (STRING (p))[len - 1] == CR_CHAR) {
198 (STRING (p))[len - 1] = NULL_CHAR;
199 }
200 // Print line number.
201 if (f == A68G_STDERR || f == A68G_STDOUT) {
202 io_close_tty_line ();
203 } else {
204 WRITE (f, NEWLINE_STRING);
205 }
206 if (NUMBER (p) == 0) {
207 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " ") >= 0);
208 } else {
209 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%-5d ", NUMBER (p) % 100000) >= 0);
210 }
211 WRITE (f, A68G (output_line));
212 // Pretty print line.
213 char *c, *c0;
214 c = c0 = STRING (p);
215 int pos = 5, col = 1;
216 int continuations = 0;
217 BOOL_T line_ended = A68G_FALSE;
218 while (!line_ended) {
219 len = 0;
220 char *new_pos = NO_TEXT;
221 if (c[0] == NULL_CHAR) {
222 a68g_bufcpy (A68G (output_line), "", BUFFER_SIZE);
223 line_ended = A68G_TRUE;
224 } else {
225 if (IS_GRAPH (c[0])) {
226 char *c1;
227 a68g_bufcpy (A68G (output_line), "", BUFFER_SIZE);
228 for (c1 = c; IS_GRAPH (c1[0]) && len <= line_width - 5; c1++, len++) {
229 a68g_bufcat (A68G (output_line), char_to_str (c1[0]), BUFFER_SIZE);
230 }
231 if (len > line_width - 5) {
232 a68g_bufcpy (A68G (output_line), char_to_str (c[0]), BUFFER_SIZE);
233 len = 1;
234 }
235 new_pos = &c[len];
236 col += len;
237 } else if (c[0] == TAB_CHAR) {
238 int n = TABULATE (col);
239 len = n;
240 col += n;
241 a68g_bufcpy (A68G (output_line), "", BUFFER_SIZE);
242 while (n--) {
243 a68g_bufcat (A68G (output_line), " ", BUFFER_SIZE);
244 }
245 new_pos = &c[1];
246 } else if (unprintable (c[0])) {
247 a68g_bufcpy (A68G (output_line), ctrl_char ((int) c[0]), BUFFER_SIZE);
248 len = strlen (A68G (output_line));
249 new_pos = &c[1];
250 col++;
251 } else {
252 a68g_bufcpy (A68G (output_line), char_to_str (c[0]), BUFFER_SIZE);
253 len = 1;
254 new_pos = &c[1];
255 col++;
256 }
257 }
258 if (!line_ended && (pos + len) <= line_width) {
259 // Still room - print a character.
260 WRITE (f, A68G (output_line));
261 pos += len;
262 c = new_pos;
263 } else {
264 // First see if there are diagnostics to be printed.
265 BOOL_T y = A68G_FALSE, z = A68G_FALSE;
266 DIAGNOSTIC_T *d = DIAGNOSTICS (p);
267 if (d != NO_DIAGNOSTIC || nwhere != NO_NODE) {
268 char *c1;
269 for (c1 = c0; c1 != c; c1++) {
270 y |= (BOOL_T) (nwhere != NO_NODE && p == LINE (INFO (nwhere)) ? c1 == where_pos (p, nwhere) : A68G_FALSE);
271 if (mask != A68G_NO_DIAGNOSTICS) {
272 for (d = DIAGNOSTICS (p); d != NO_DIAGNOSTIC; FORWARD (d)) {
273 z = (BOOL_T) (z | (c1 == diag_pos (p, d)));
274 }
275 }
276 }
277 }
278 // If diagnostics are to be printed then print marks.
279 if (y || z) {
280 DIAGNOSTIC_T *d2;
281 char *c1;
282 int col_2 = 1;
283 WRITE (f, "\n ");
284 for (c1 = c0; c1 != c; c1++) {
285 int k = 0, diags_at_this_pos = 0;
286 for (d2 = DIAGNOSTICS (p); d2 != NO_DIAGNOSTIC; FORWARD (d2)) {
287 if (c1 == diag_pos (p, d2)) {
288 diags_at_this_pos++;
289 k = NUMBER (d2);
290 }
291 }
292 if (y == A68G_TRUE && c1 == where_pos (p, nwhere)) {
293 a68g_bufcpy (A68G (output_line), "-", BUFFER_SIZE);
294 } else if (diags_at_this_pos != 0) {
295 if (mask == A68G_NO_DIAGNOSTICS) {
296 a68g_bufcpy (A68G (output_line), " ", BUFFER_SIZE);
297 } else if (diags_at_this_pos == 1) {
298 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%c", digchar (k)) >= 0);
299 } else {
300 a68g_bufcpy (A68G (output_line), "*", BUFFER_SIZE);
301 }
302 } else {
303 if (unprintable (c1[0])) {
304 size_t n = strlen (ctrl_char (c1[0]));
305 col_2 += 1;
306 a68g_bufcpy (A68G (output_line), "", BUFFER_SIZE);
307 while (n--) {
308 a68g_bufcat (A68G (output_line), " ", BUFFER_SIZE);
309 }
310 } else if (c1[0] == TAB_CHAR) {
311 int n = TABULATE (col_2);
312 col_2 += n;
313 a68g_bufcpy (A68G (output_line), "", BUFFER_SIZE);
314 while (n--) {
315 a68g_bufcat (A68G (output_line), " ", BUFFER_SIZE);
316 }
317 } else {
318 a68g_bufcpy (A68G (output_line), " ", BUFFER_SIZE);
319 col_2++;
320 }
321 }
322 WRITE (f, A68G (output_line));
323 }
324 }
325 // Resume pretty printing of line.
326 if (!line_ended) {
327 continuations++;
328 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n.%1d ", continuations) >= 0);
329 WRITE (f, A68G (output_line));
330 if (continuations >= 9) {
331 WRITE (f, "...");
332 line_ended = A68G_TRUE;
333 } else {
334 c0 = c;
335 pos = 5;
336 col = 1;
337 }
338 }
339 }
340 }
341 // Print the diagnostics.
342 if (mask) {
343 if (DIAGNOSTICS (p) != NO_DIAGNOSTIC) {
344 DIAGNOSTIC_T *d;
345 for (d = DIAGNOSTICS (p); d != NO_DIAGNOSTIC; FORWARD (d)) {
346 if (mask == A68G_RUNTIME_ERROR) {
347 if (IS (d, A68G_RUNTIME_ERROR) || IS (d, A68G_MATH_ERROR) || (IS (d, A68G_MATH_WARNING))) {
348 WRITE (f, NEWLINE_STRING);
349 pretty_diag (f, TEXT (d));
350 }
351 } else {
352 WRITE (f, NEWLINE_STRING);
353 pretty_diag (f, TEXT (d));
354 }
355 }
356 }
357 }
358 }
359
360 //! @brief Write diagnostics to STDERR.
361
362 void diagnostics_to_terminal (LINE_T * p, int sev)
363 {
364 for (; p != NO_LINE; FORWARD (p)) {
365 if (DIAGNOSTICS (p) != NO_DIAGNOSTIC) {
366 int N = 0;
367 for (DIAGNOSTIC_T *d = DIAGNOSTICS (p); d != NO_DIAGNOSTIC; FORWARD (d)) {
368 if (sev == A68G_ALL_DIAGNOSTICS) {
369 if (
370 IS (d, A68G_ERROR) ||
371 IS (d, A68G_NOTICE) ||
372 IS (d, A68G_SCANNER_ERROR) ||
373 IS (d, A68G_SYNTAX_ERROR) ||
374 IS (d, A68G_WARNING)
375 ) {
376 N++;
377 }
378 }
379 if (sev == A68G_ALL_DIAGNOSTICS || sev == A68G_RUNTIME_ERROR) {
380 if (
381 IS (d, A68G_MATH_ERROR) ||
382 IS (d, A68G_MATH_WARNING) ||
383 IS (d, A68G_RUNTIME_ERROR)
384 ) {
385 N++;
386 }
387 }
388 }
389 if (N > 0) {
390 write_source_line (A68G_STDERR, p, NO_NODE, sev);
391 }
392 }
393 }
394 }
395
396 //! @brief Give an intelligible error and exit.
397
398 void scan_error (LINE_T * u, char *v, char *txt)
399 {
400 if (errno != 0) {
401 diagnostic (A68G_SCANNER_ERROR, NO_NODE, txt, u, v, error_specification ());
402 } else {
403 diagnostic (A68G_SCANNER_ERROR, NO_NODE, txt, u, v, ERROR_UNSPECIFIED);
404 }
405 longjmp (RENDEZ_VOUS (&A68G_JOB), 1);
406 }
407
408 void scan_error_info (LINE_T * u, char *v, char *txt, char *info)
409 {
410 if (info != NO_TEXT) {
411 size_t len = strlen (txt) + 3;
412 char *txti = a68g_alloc(len, __FILE__, __LINE__);
413 ABEND (txti == NO_TEXT, ERROR_MEMORY_FULL, NO_TEXT);
414 a68g_bufcpy (txti, txt, len);
415 a68g_bufcat (txti, " Z", len);
416 if (errno != 0) {
417 diagnostic (A68G_SCANNER_ERROR, NO_NODE, txti, u, v, info, error_specification ());
418 } else {
419 diagnostic (A68G_SCANNER_ERROR, NO_NODE, txti, u, v, info, ERROR_UNSPECIFIED);
420 }
421 longjmp (RENDEZ_VOUS (&A68G_JOB), 1);
422 } else {
423 scan_error(u, v, txt);
424 }
425 }
426
427 //! @brief Give an intelligible warning.
428
429 void scan_warning (LINE_T * u, char *v, char *txt)
430 {
431 if (errno != 0) {
432 diagnostic (A68G_SCANNER_WARNING, NO_NODE, txt, u, v, error_specification ());
433 } else {
434 diagnostic (A68G_SCANNER_WARNING, NO_NODE, txt, u, v, ERROR_UNSPECIFIED);
435 }
436 }
437
438 //! @brief Get severity text.
439
440 char *get_severity (int sev)
441 {
442 switch (sev) {
443 case A68G_ERROR: {
444 return "error";
445 }
446 case A68G_SYNTAX_ERROR: {
447 return "syntax error";
448 }
449 case A68G_RUNTIME_ERROR: {
450 return "runtime error";
451 }
452 case A68G_MATH_ERROR: {
453 return "math error";
454 }
455 case A68G_MATH_WARNING: {
456 return "math warning";
457 }
458 case A68G_NOTICE: {
459 return "notice";
460 }
461 case A68G_WARNING: {
462 return "warning";
463 }
464 case A68G_SCANNER_ERROR: {
465 return "scanner error";
466 }
467 case A68G_SCANNER_WARNING: {
468 return "scanner warning";
469 }
470 default: {
471 return NO_TEXT;
472 }
473 }
474 }
475
476 //! @brief Print diagnostic.
477
478 void write_diagnostic (int sev, char *b)
479 {
480 char *severity = get_severity (sev);
481 if (severity == NO_TEXT) {
482 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: %s.", A68G (a68g_cmd_name), b) >= 0);
483 } else {
484 char txt[SMALL_BUFFER_SIZE];
485 a68g_bufcpy (txt, get_severity (sev), SMALL_BUFFER_SIZE);
486 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: %s: %s.", A68G (a68g_cmd_name), txt, b) >= 0);
487 }
488 io_close_tty_line ();
489 pretty_diag (A68G_STDERR, A68G (output_line));
490 }
491
492 //! @brief Add diagnostic to source line.
493
494 void add_diagnostic (LINE_T * line, char *pos, NODE_T * p, int sev, char *b)
495 {
496 // Add diagnostic and choose GNU style or non-GNU style.
497 DIAGNOSTIC_T *msg = (DIAGNOSTIC_T *) get_heap_space (SIZE_ALIGNED (DIAGNOSTIC_T));
498 DIAGNOSTIC_T **ref_msg;
499 BUFFER a, nst;
500 char *severity = get_severity (sev);
501 int k = 1;
502 if (line == NO_LINE && p == NO_NODE) {
503 return;
504 }
505 if (A68G (in_monitor)) {
506 monitor_error (b, NO_TEXT);
507 return;
508 }
509 nst[0] = NULL_CHAR;
510 if (line == NO_LINE && p != NO_NODE) {
511 line = LINE (INFO (p));
512 }
513 while (line != NO_LINE && NUMBER (line) == 0) {
514 FORWARD (line);
515 }
516 if (line == NO_LINE) {
517 return;
518 }
519 ref_msg = &(DIAGNOSTICS (line));
520 while (*ref_msg != NO_DIAGNOSTIC) {
521 ref_msg = &(NEXT (*ref_msg));
522 k++;
523 }
524 if (p != NO_NODE) {
525 NODE_T *n = NEST (p);
526 if (n != NO_NODE && NSYMBOL (n) != NO_TEXT) {
527 char *nt = non_terminal_string (A68G (edit_line), ATTRIBUTE (n));
528 if (nt != NO_TEXT) {
529 if (LINE_NUMBER (n) == 0) {
530 ASSERT (a68g_bufprt (nst, SNPRINTF_SIZE, ", in %s", nt) >= 0);
531 } else {
532 if (MOID (n) != NO_MOID) {
533 if (LINE_NUMBER (n) == NUMBER (line)) {
534 ASSERT (a68g_bufprt (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);
535 } else {
536 ASSERT (a68g_bufprt (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);
537 }
538 } else {
539 if (LINE_NUMBER (n) == NUMBER (line)) {
540 ASSERT (a68g_bufprt (nst, SNPRINTF_SIZE, ", in %s starting at \"%.64s\" in this line", nt, NSYMBOL (n)) >= 0);
541 } else {
542 ASSERT (a68g_bufprt (nst, SNPRINTF_SIZE, ", in %s starting at \"%.64s\" in line %d", nt, NSYMBOL (n), LINE_NUMBER (n)) >= 0);
543 }
544 }
545 }
546 }
547 }
548 }
549 if (severity == NO_TEXT) {
550 if (FILENAME (line) != NO_TEXT && strcmp (FILE_SOURCE_NAME (&A68G_JOB), FILENAME (line)) == 0) {
551 ASSERT (a68g_bufprt (a, SNPRINTF_SIZE, "%s: %x: %s", A68G (a68g_cmd_name), (unt) k, b) >= 0);
552 } else if (FILENAME (line) != NO_TEXT) {
553 ASSERT (a68g_bufprt (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68G (a68g_cmd_name), FILENAME (line), (unt) k, b) >= 0);
554 } else {
555 ASSERT (a68g_bufprt (a, SNPRINTF_SIZE, "%s: %x: %s", A68G (a68g_cmd_name), (unt) k, b) >= 0);
556 }
557 } else {
558 char st[SMALL_BUFFER_SIZE];
559 a68g_bufcpy (st, get_severity (sev), SMALL_BUFFER_SIZE);
560 if (FILENAME (line) != NO_TEXT && strcmp (FILE_SOURCE_NAME (&A68G_JOB), FILENAME (line)) == 0) {
561 ASSERT (a68g_bufprt (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68G (a68g_cmd_name), st, (unt) k, b) >= 0);
562 } else if (FILENAME (line) != NO_TEXT) {
563 ASSERT (a68g_bufprt (a, SNPRINTF_SIZE, "%s: %s: %s: %x: %s", A68G (a68g_cmd_name), FILENAME (line), st, (unt) k, b) >= 0);
564 } else {
565 ASSERT (a68g_bufprt (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68G (a68g_cmd_name), st, (unt) k, b) >= 0);
566 }
567 }
568 // cppcheck might complain here but this memory is not returned, for obvious reasons.
569 *ref_msg = msg;
570 ATTRIBUTE (msg) = sev;
571 if (nst[0] != NULL_CHAR) {
572 a68g_bufcat (a, nst, BUFFER_SIZE);
573 }
574 a68g_bufcat (a, ".", BUFFER_SIZE);
575 TEXT (msg) = new_string (a, NO_TEXT);
576 WHERE (msg) = p;
577 LINE (msg) = line;
578 SYMBOL (msg) = pos;
579 NUMBER (msg) = k;
580 NEXT (msg) = NO_DIAGNOSTIC;
581 }
582
583 //! @brief Give a diagnostic message.
584
585 void diagnostic (STATUS_MASK_T sev, NODE_T * p, char *loc_str, ...)
586 {
587 va_list args;
588 char *t = loc_str, b[BUFFER_SIZE];
589 BOOL_T compose = A68G_TRUE, issue = A68G_TRUE;
590 va_start (args, loc_str);
591 b[0] = NULL_CHAR;
592 // Node or line?
593 LINE_T *line = NO_LINE;
594 char *pos = NO_TEXT;
595 if (p == NO_NODE) {
596 line = va_arg (args, LINE_T *);
597 pos = va_arg (args, char *);
598 }
599 // No warnings or notices?
600 if (sev == A68G_NOTICE && OPTION_NO_NOTICES (&A68G_JOB)) {
601 va_end (args);
602 return;
603 }
604 if (sev == A68G_WARNING && OPTION_NO_WARNINGS (&A68G_JOB)) {
605 va_end (args);
606 return;
607 }
608 if (sev == A68G_MATH_WARNING && OPTION_NO_WARNINGS (&A68G_JOB)) {
609 va_end (args);
610 return;
611 }
612 if (sev == A68G_NOTICE && OPTION_QUIET (&A68G_JOB)) {
613 va_end (args);
614 return;
615 }
616 if (sev == A68G_WARNING && OPTION_QUIET (&A68G_JOB)) {
617 va_end (args);
618 return;
619 }
620 if (sev == A68G_MATH_WARNING && OPTION_QUIET (&A68G_JOB)) {
621 va_end (args);
622 return;
623 }
624 // Suppressed?.
625 if (sev == A68G_ERROR || sev == A68G_SYNTAX_ERROR) {
626 if (ERROR_COUNT (&A68G_JOB) == MAX_ERRORS) {
627 a68g_bufcpy (b, "further diagnostics suppressed", BUFFER_SIZE);
628 compose = A68G_FALSE;
629 sev = A68G_ERROR;
630 } else if (ERROR_COUNT (&A68G_JOB) > MAX_ERRORS) {
631 ERROR_COUNT (&A68G_JOB)++;
632 compose = issue = A68G_FALSE;
633 }
634 } else if (sev == A68G_NOTICE || sev == A68G_WARNING || sev == A68G_MATH_WARNING) {
635 if (WARNING_COUNT (&A68G_JOB) == MAX_ERRORS) {
636 a68g_bufcpy (b, "further diagnostics suppressed", BUFFER_SIZE);
637 compose = A68G_FALSE;
638 } else if (WARNING_COUNT (&A68G_JOB) > MAX_ERRORS) {
639 WARNING_COUNT (&A68G_JOB)++;
640 compose = issue = A68G_FALSE;
641 }
642 }
643 if (compose) {
644 // Synthesize diagnostic message.
645 if ((sev & A68G_NO_SYNTHESIS) != NULL_MASK) {
646 sev &= ~A68G_NO_SYNTHESIS;
647 a68g_bufcat (b, t, BUFFER_SIZE);
648 } else {
649 // Legend for special symbols:
650 // * as first character, copy rest of string literally
651 // # skip extra syntactical information
652 // @ non terminal
653 // A non terminal
654 // B keyword
655 // C context
656 // D argument in decimal
657 // H char argument
658 // K 'LONG'
659 // L line number
660 // M moid - if error mode return without giving a message
661 // N mode - M_NIL
662 // O moid - operand
663 // S quoted symbol, when possible with typographical display features
664 // X expected attribute
665 // Y string literal.
666 // Z quoted string literal.
667 if (t[0] == '*') {
668 a68g_bufcat (b, &t[1], BUFFER_SIZE);
669 } else
670 while (t[0] != NULL_CHAR) {
671 if (t[0] == '#') {
672 ;
673 } else if (t[0] == '@') {
674 if (p == NO_NODE) {
675 a68g_bufcat (b, "construct", BUFFER_SIZE);
676 } else {
677 char *nt = non_terminal_string (A68G (edit_line), ATTRIBUTE (p));
678 if (t != NO_TEXT) {
679 a68g_bufcat (b, nt, BUFFER_SIZE);
680 } else {
681 a68g_bufcat (b, "construct", BUFFER_SIZE);
682 }
683 }
684 } else if (t[0] == 'A') {
685 int att = va_arg (args, int);
686 char *nt = non_terminal_string (A68G (edit_line), att);
687 if (nt != NO_TEXT) {
688 a68g_bufcat (b, nt, BUFFER_SIZE);
689 } else {
690 a68g_bufcat (b, "construct", BUFFER_SIZE);
691 }
692 } else if (t[0] == 'B') {
693 int att = va_arg (args, int);
694 KEYWORD_T *nt = find_keyword_from_attribute (A68G (top_keyword), att);
695 if (nt != NO_KEYWORD) {
696 a68g_bufcat (b, "\"", BUFFER_SIZE);
697 a68g_bufcat (b, TEXT (nt), BUFFER_SIZE);
698 a68g_bufcat (b, "\"", BUFFER_SIZE);
699 } else {
700 a68g_bufcat (b, "keyword", BUFFER_SIZE);
701 }
702 } else if (t[0] == 'C') {
703 int att = va_arg (args, int);
704 if (att == NO_SORT) {
705 a68g_bufcat (b, "this", BUFFER_SIZE);
706 }
707 if (att == SOFT) {
708 a68g_bufcat (b, "a soft", BUFFER_SIZE);
709 } else if (att == WEAK) {
710 a68g_bufcat (b, "a weak", BUFFER_SIZE);
711 } else if (att == MEEK) {
712 a68g_bufcat (b, "a meek", BUFFER_SIZE);
713 } else if (att == FIRM) {
714 a68g_bufcat (b, "a firm", BUFFER_SIZE);
715 } else if (att == STRONG) {
716 a68g_bufcat (b, "a strong", BUFFER_SIZE);
717 }
718 } else if (t[0] == 'D') {
719 int a = va_arg (args, int);
720 BUFFER d;
721 BUFCLR (d);
722 ASSERT (a68g_bufprt (d, SNPRINTF_SIZE, "%d", a) >= 0);
723 a68g_bufcat (b, d, BUFFER_SIZE);
724 } else if (t[0] == 'H') {
725 char *a = va_arg (args, char *);
726 char d[SMALL_BUFFER_SIZE];
727 ASSERT (a68g_bufprt (d, (size_t) SMALL_BUFFER_SIZE, "\"%c\"", a[0]) >= 0);
728 a68g_bufcat (b, d, BUFFER_SIZE);
729 } else if (t[0] == 'K') {
730 a68g_bufcat (b, "LONG", BUFFER_SIZE);
731 } else if (t[0] == 'L') {
732 LINE_T *a = va_arg (args, LINE_T *);
733 ABEND (a == NO_LINE, ERROR_INTERNAL_CONSISTENCY, NO_TEXT);
734 if (NUMBER (a) == 0) {
735 a68g_bufcat (b, "in standard environment", BUFFER_SIZE);
736 } else {
737 char d[SMALL_BUFFER_SIZE];
738 if (p != NO_NODE && NUMBER (a) == LINE_NUMBER (p)) {
739 ASSERT (a68g_bufprt (d, (size_t) SMALL_BUFFER_SIZE, "in this line") >= 0);
740 } else {
741 ASSERT (a68g_bufprt (d, (size_t) SMALL_BUFFER_SIZE, "in line %d", NUMBER (a)) >= 0);
742 }
743 a68g_bufcat (b, d, BUFFER_SIZE);
744 }
745 } else if (t[0] == 'M') {
746 MOID_T *moid = va_arg (args, MOID_T *);
747 if (moid == NO_MOID || moid == M_ERROR) {
748 moid = M_UNDEFINED;
749 }
750 if (IS (moid, SERIES_MODE)) {
751 if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) {
752 a68g_bufcat (b, moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE);
753 } else {
754 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
755 }
756 } else {
757 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
758 }
759 } else if (t[0] == 'N') {
760 a68g_bufcat (b, "NIL name of mode ", BUFFER_SIZE);
761 MOID_T *moid = va_arg (args, MOID_T *);
762 if (moid != NO_MOID) {
763 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
764 }
765 } else if (t[0] == 'O') {
766 MOID_T *moid = va_arg (args, MOID_T *);
767 if (moid == NO_MOID || moid == M_ERROR) {
768 moid = M_UNDEFINED;
769 }
770 if (moid == M_VOID) {
771 a68g_bufcat (b, "UNION (VOID, ..)", BUFFER_SIZE);
772 } else if (IS (moid, SERIES_MODE)) {
773 if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) {
774 a68g_bufcat (b, moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE);
775 } else {
776 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
777 }
778 } else {
779 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
780 }
781 } else if (t[0] == 'S') {
782 if (p != NO_NODE && NSYMBOL (p) != NO_TEXT) {
783 char *txt = NSYMBOL (p);
784 char *sym = NCHAR_IN_LINE (p);
785 size_t size = strlen (txt);
786 a68g_bufcat (b, "\"", BUFFER_SIZE);
787 if (txt[0] != sym[0] || strlen (sym) < size) {
788 a68g_bufcat (b, txt, BUFFER_SIZE);
789 } else {
790 int n = 0;
791 while (n < size) {
792 if (IS_PRINT (sym[0])) {
793 char str[2];
794 str[0] = sym[0];
795 str[1] = NULL_CHAR;
796 a68g_bufcat (b, str, BUFFER_SIZE);
797 }
798 if (TO_LOWER (txt[0]) == TO_LOWER (sym[0])) {
799 txt++;
800 n++;
801 }
802 sym++;
803 }
804 }
805 a68g_bufcat (b, "\"", BUFFER_SIZE);
806 } else {
807 a68g_bufcat (b, "symbol", BUFFER_SIZE);
808 }
809 } else if (t[0] == 'V') {
810 a68g_bufcat (b, PACKAGE_STRING, BUFFER_SIZE);
811 } else if (t[0] == 'X') {
812 int att = va_arg (args, int);
813 BUFFER z;
814 (void) non_terminal_string (z, att);
815 a68g_bufcat (b, new_string (z, NO_TEXT), BUFFER_SIZE);
816 } else if (t[0] == 'Y') {
817 char *loc_string = va_arg (args, char *);
818 if (loc_string != NO_TEXT) {
819 a68g_bufcat (b, loc_string, BUFFER_SIZE);
820 }
821 } else if (t[0] == 'Z') {
822 char *loc_string = va_arg (args, char *);
823 a68g_bufcat (b, "\"", BUFFER_SIZE);
824 if (loc_string != NO_TEXT) {
825 a68g_bufcat (b, loc_string, BUFFER_SIZE);
826 }
827 a68g_bufcat (b, "\"", BUFFER_SIZE);
828 } else {
829 char q[2];
830 q[0] = t[0];
831 q[1] = NULL_CHAR;
832 a68g_bufcat (b, q, BUFFER_SIZE);
833 }
834 t++;
835 }
836 // Add information from errno, if any.
837 if (errno != 0) {
838 char *loc_str2 = new_string (error_specification (), NO_TEXT);
839 if (loc_str2 != NO_TEXT) {
840 char *stu;
841 a68g_bufcat (b, ", ", BUFFER_SIZE);
842 for (stu = loc_str2; stu[0] != NULL_CHAR; stu++) {
843 stu[0] = (char) TO_LOWER (stu[0]);
844 }
845 a68g_bufcat (b, loc_str2, BUFFER_SIZE);
846 }
847 }
848 }
849 }
850 // Construct a diagnostic message.
851 if (issue) {
852 if (sev == A68G_NOTICE || sev == A68G_WARNING) {
853 WARNING_COUNT (&A68G_JOB)++;
854 } else {
855 ERROR_COUNT (&A68G_JOB)++;
856 }
857 if (p == NO_NODE) {
858 if (line == NO_LINE) {
859 write_diagnostic (sev, b);
860 } else {
861 add_diagnostic (line, pos, NO_NODE, sev, b);
862 }
863 } else {
864 add_diagnostic (NO_LINE, NO_TEXT, p, sev, b);
865 if (sev == A68G_MATH_WARNING && p != NO_NODE && LINE (INFO (p)) != NO_LINE) {
866 write_source_line (A68G_STDERR, LINE (INFO (p)), p, A68G_TRUE);
867 WRITE (A68G_STDERR, NEWLINE_STRING);
868 }
869 }
870 }
871 va_end (args);
872 }
© 2001-2026 J.M. van der Veer
jmvdveer@algol68genie.nl
