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