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