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 *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 txt[SMALL_BUFFER_SIZE];
481 char *severity = get_severity (sev);
482 if (severity == NO_TEXT) {
483 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: %s.", A68G (a68g_cmd_name), b) >= 0);
484 } else {
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 st[SMALL_BUFFER_SIZE];
501 char *severity = get_severity (sev);
502 int k = 1;
503 if (line == NO_LINE && p == NO_NODE) {
504 return;
505 }
506 if (A68G (in_monitor)) {
507 monitor_error (b, NO_TEXT);
508 return;
509 }
510 nst[0] = NULL_CHAR;
511 if (line == NO_LINE && p != NO_NODE) {
512 line = LINE (INFO (p));
513 }
514 while (line != NO_LINE && NUMBER (line) == 0) {
515 FORWARD (line);
516 }
517 if (line == NO_LINE) {
518 return;
519 }
520 ref_msg = &(DIAGNOSTICS (line));
521 while (*ref_msg != NO_DIAGNOSTIC) {
522 ref_msg = &(NEXT (*ref_msg));
523 k++;
524 }
525 if (p != NO_NODE) {
526 NODE_T *n = NEST (p);
527 if (n != NO_NODE && NSYMBOL (n) != NO_TEXT) {
528 char *nt = non_terminal_string (A68G (edit_line), ATTRIBUTE (n));
529 if (nt != NO_TEXT) {
530 if (LINE_NUMBER (n) == 0) {
531 ASSERT (a68g_bufprt (nst, SNPRINTF_SIZE, ", in %s", nt) >= 0);
532 } else {
533 if (MOID (n) != NO_MOID) {
534 if (LINE_NUMBER (n) == NUMBER (line)) {
535 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);
536 } else {
537 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);
538 }
539 } else {
540 if (LINE_NUMBER (n) == NUMBER (line)) {
541 ASSERT (a68g_bufprt (nst, SNPRINTF_SIZE, ", in %s starting at \"%.64s\" in this line", nt, NSYMBOL (n)) >= 0);
542 } else {
543 ASSERT (a68g_bufprt (nst, SNPRINTF_SIZE, ", in %s starting at \"%.64s\" in line %d", nt, NSYMBOL (n), LINE_NUMBER (n)) >= 0);
544 }
545 }
546 }
547 }
548 }
549 }
550 if (severity == NO_TEXT) {
551 if (FILENAME (line) != NO_TEXT && strcmp (FILE_SOURCE_NAME (&A68G_JOB), FILENAME (line)) == 0) {
552 ASSERT (a68g_bufprt (a, SNPRINTF_SIZE, "%s: %x: %s", A68G (a68g_cmd_name), (unt) k, b) >= 0);
553 } else if (FILENAME (line) != NO_TEXT) {
554 ASSERT (a68g_bufprt (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68G (a68g_cmd_name), FILENAME (line), (unt) k, b) >= 0);
555 } else {
556 ASSERT (a68g_bufprt (a, SNPRINTF_SIZE, "%s: %x: %s", A68G (a68g_cmd_name), (unt) k, b) >= 0);
557 }
558 } else {
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 MOID_T *moid = NO_MOID;
589 char *t = loc_str, b[BUFFER_SIZE];
590 BOOL_T compose = A68G_TRUE, issue = A68G_TRUE;
591 va_start (args, loc_str);
592 b[0] = NULL_CHAR;
593 // Node or line?
594 LINE_T *line = NO_LINE;
595 char *pos = NO_TEXT;
596 if (p == NO_NODE) {
597 line = va_arg (args, LINE_T *);
598 pos = va_arg (args, char *);
599 }
600 // No warnings or notices?
601 if (sev == A68G_NOTICE && OPTION_NO_NOTICES (&A68G_JOB)) {
602 va_end (args);
603 return;
604 }
605 if (sev == A68G_WARNING && OPTION_NO_WARNINGS (&A68G_JOB)) {
606 va_end (args);
607 return;
608 }
609 if (sev == A68G_MATH_WARNING && OPTION_NO_WARNINGS (&A68G_JOB)) {
610 va_end (args);
611 return;
612 }
613 if (sev == A68G_NOTICE && OPTION_QUIET (&A68G_JOB)) {
614 va_end (args);
615 return;
616 }
617 if (sev == A68G_WARNING && OPTION_QUIET (&A68G_JOB)) {
618 va_end (args);
619 return;
620 }
621 if (sev == A68G_MATH_WARNING && OPTION_QUIET (&A68G_JOB)) {
622 va_end (args);
623 return;
624 }
625 // Suppressed?.
626 if (sev == A68G_ERROR || sev == A68G_SYNTAX_ERROR) {
627 if (ERROR_COUNT (&A68G_JOB) == MAX_ERRORS) {
628 a68g_bufcpy (b, "further diagnostics suppressed", BUFFER_SIZE);
629 compose = A68G_FALSE;
630 sev = A68G_ERROR;
631 } else if (ERROR_COUNT (&A68G_JOB) > MAX_ERRORS) {
632 ERROR_COUNT (&A68G_JOB)++;
633 compose = issue = A68G_FALSE;
634 }
635 } else if (sev == A68G_NOTICE || sev == A68G_WARNING || sev == A68G_MATH_WARNING) {
636 if (WARNING_COUNT (&A68G_JOB) == MAX_ERRORS) {
637 a68g_bufcpy (b, "further diagnostics suppressed", BUFFER_SIZE);
638 compose = A68G_FALSE;
639 } else if (WARNING_COUNT (&A68G_JOB) > MAX_ERRORS) {
640 WARNING_COUNT (&A68G_JOB)++;
641 compose = issue = A68G_FALSE;
642 }
643 }
644 if (compose) {
645 // Synthesize diagnostic message.
646 if ((sev & A68G_NO_SYNTHESIS) != NULL_MASK) {
647 sev &= ~A68G_NO_SYNTHESIS;
648 a68g_bufcat (b, t, BUFFER_SIZE);
649 } else {
650 // Legend for special symbols:
651 // * as first character, copy rest of string literally
652 // # skip extra syntactical information
653 // @ non terminal
654 // A non terminal
655 // B keyword
656 // C context
657 // D argument in decimal
658 // H char argument
659 // K 'LONG'
660 // L line number
661 // M moid - if error mode return without giving a message
662 // N mode - M_NIL
663 // O moid - operand
664 // S quoted symbol, when possible with typographical display features
665 // X expected attribute
666 // Y string literal.
667 // Z quoted string literal.
668 if (t[0] == '*') {
669 a68g_bufcat (b, &t[1], BUFFER_SIZE);
670 } else
671 while (t[0] != NULL_CHAR) {
672 if (t[0] == '#') {
673 ;
674 } else if (t[0] == '@') {
675 if (p == NO_NODE) {
676 a68g_bufcat (b, "construct", BUFFER_SIZE);
677 } else {
678 char *nt = non_terminal_string (A68G (edit_line), ATTRIBUTE (p));
679 if (t != NO_TEXT) {
680 a68g_bufcat (b, nt, BUFFER_SIZE);
681 } else {
682 a68g_bufcat (b, "construct", BUFFER_SIZE);
683 }
684 }
685 } else if (t[0] == 'A') {
686 int att = va_arg (args, int);
687 char *nt = non_terminal_string (A68G (edit_line), att);
688 if (nt != NO_TEXT) {
689 a68g_bufcat (b, nt, BUFFER_SIZE);
690 } else {
691 a68g_bufcat (b, "construct", BUFFER_SIZE);
692 }
693 } else if (t[0] == 'B') {
694 int att = va_arg (args, int);
695 KEYWORD_T *nt = find_keyword_from_attribute (A68G (top_keyword), att);
696 if (nt != NO_KEYWORD) {
697 a68g_bufcat (b, "\"", BUFFER_SIZE);
698 a68g_bufcat (b, TEXT (nt), BUFFER_SIZE);
699 a68g_bufcat (b, "\"", BUFFER_SIZE);
700 } else {
701 a68g_bufcat (b, "keyword", BUFFER_SIZE);
702 }
703 } else if (t[0] == 'C') {
704 int att = va_arg (args, int);
705 if (att == NO_SORT) {
706 a68g_bufcat (b, "this", BUFFER_SIZE);
707 }
708 if (att == SOFT) {
709 a68g_bufcat (b, "a soft", BUFFER_SIZE);
710 } else if (att == WEAK) {
711 a68g_bufcat (b, "a weak", BUFFER_SIZE);
712 } else if (att == MEEK) {
713 a68g_bufcat (b, "a meek", BUFFER_SIZE);
714 } else if (att == FIRM) {
715 a68g_bufcat (b, "a firm", BUFFER_SIZE);
716 } else if (att == STRONG) {
717 a68g_bufcat (b, "a strong", BUFFER_SIZE);
718 }
719 } else if (t[0] == 'D') {
720 int a = va_arg (args, int);
721 BUFFER d;
722 BUFCLR (d);
723 ASSERT (a68g_bufprt (d, SNPRINTF_SIZE, "%d", a) >= 0);
724 a68g_bufcat (b, d, BUFFER_SIZE);
725 } else if (t[0] == 'H') {
726 char *a = va_arg (args, char *);
727 char d[SMALL_BUFFER_SIZE];
728 ASSERT (a68g_bufprt (d, (size_t) SMALL_BUFFER_SIZE, "\"%c\"", a[0]) >= 0);
729 a68g_bufcat (b, d, BUFFER_SIZE);
730 } else if (t[0] == 'K') {
731 a68g_bufcat (b, "LONG", BUFFER_SIZE);
732 } else if (t[0] == 'L') {
733 LINE_T *a = va_arg (args, LINE_T *);
734 char d[SMALL_BUFFER_SIZE];
735 ABEND (a == NO_LINE, ERROR_INTERNAL_CONSISTENCY, NO_TEXT);
736 if (NUMBER (a) == 0) {
737 a68g_bufcat (b, "in standard environment", BUFFER_SIZE);
738 } else {
739 if (p != NO_NODE && NUMBER (a) == LINE_NUMBER (p)) {
740 ASSERT (a68g_bufprt (d, (size_t) SMALL_BUFFER_SIZE, "in this line") >= 0);
741 } else {
742 ASSERT (a68g_bufprt (d, (size_t) SMALL_BUFFER_SIZE, "in line %d", NUMBER (a)) >= 0);
743 }
744 a68g_bufcat (b, d, BUFFER_SIZE);
745 }
746 } else if (t[0] == 'M') {
747 moid = va_arg (args, MOID_T *);
748 if (moid == NO_MOID || moid == M_ERROR) {
749 moid = M_UNDEFINED;
750 }
751 if (IS (moid, SERIES_MODE)) {
752 if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) {
753 a68g_bufcat (b, moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE);
754 } else {
755 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
756 }
757 } else {
758 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
759 }
760 } else if (t[0] == 'N') {
761 a68g_bufcat (b, "NIL name of mode ", BUFFER_SIZE);
762 moid = va_arg (args, MOID_T *);
763 if (moid != NO_MOID) {
764 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
765 }
766 } else if (t[0] == 'O') {
767 moid = va_arg (args, MOID_T *);
768 if (moid == NO_MOID || moid == M_ERROR) {
769 moid = M_UNDEFINED;
770 }
771 if (moid == M_VOID) {
772 a68g_bufcat (b, "UNION (VOID, ..)", BUFFER_SIZE);
773 } else if (IS (moid, SERIES_MODE)) {
774 if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) {
775 a68g_bufcat (b, moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE);
776 } else {
777 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
778 }
779 } else {
780 a68g_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
781 }
782 } else if (t[0] == 'S') {
783 if (p != NO_NODE && NSYMBOL (p) != NO_TEXT) {
784 char *txt = NSYMBOL (p);
785 char *sym = NCHAR_IN_LINE (p);
786 int n = 0;
787 size_t size = strlen (txt);
788 a68g_bufcat (b, "\"", BUFFER_SIZE);
789 if (txt[0] != sym[0] || strlen (sym) < size) {
790 a68g_bufcat (b, txt, BUFFER_SIZE);
791 } else {
792 while (n < size) {
793 if (IS_PRINT (sym[0])) {
794 char str[2];
795 str[0] = sym[0];
796 str[1] = NULL_CHAR;
797 a68g_bufcat (b, str, BUFFER_SIZE);
798 }
799 if (TO_LOWER (txt[0]) == TO_LOWER (sym[0])) {
800 txt++;
801 n++;
802 }
803 sym++;
804 }
805 }
806 a68g_bufcat (b, "\"", BUFFER_SIZE);
807 } else {
808 a68g_bufcat (b, "symbol", BUFFER_SIZE);
809 }
810 } else if (t[0] == 'V') {
811 a68g_bufcat (b, PACKAGE_STRING, BUFFER_SIZE);
812 } else if (t[0] == 'X') {
813 int att = va_arg (args, int);
814 BUFFER z;
815 (void) non_terminal_string (z, att);
816 a68g_bufcat (b, new_string (z, NO_TEXT), BUFFER_SIZE);
817 } else if (t[0] == 'Y') {
818 char *loc_string = va_arg (args, char *);
819 if (loc_string != NO_TEXT) {
820 a68g_bufcat (b, loc_string, BUFFER_SIZE);
821 }
822 } else if (t[0] == 'Z') {
823 char *loc_string = va_arg (args, char *);
824 a68g_bufcat (b, "\"", BUFFER_SIZE);
825 if (loc_string != NO_TEXT) {
826 a68g_bufcat (b, loc_string, BUFFER_SIZE);
827 }
828 a68g_bufcat (b, "\"", BUFFER_SIZE);
829 } else {
830 char q[2];
831 q[0] = t[0];
832 q[1] = NULL_CHAR;
833 a68g_bufcat (b, q, BUFFER_SIZE);
834 }
835 t++;
836 }
837 // Add information from errno, if any.
838 if (errno != 0) {
839 char *loc_str2 = new_string (error_specification (), NO_TEXT);
840 if (loc_str2 != NO_TEXT) {
841 char *stu;
842 a68g_bufcat (b, ", ", BUFFER_SIZE);
843 for (stu = loc_str2; stu[0] != NULL_CHAR; stu++) {
844 stu[0] = (char) TO_LOWER (stu[0]);
845 }
846 a68g_bufcat (b, loc_str2, BUFFER_SIZE);
847 }
848 }
849 }
850 }
851 // Construct a diagnostic message.
852 if (issue) {
853 if (sev == A68G_NOTICE || sev == A68G_WARNING) {
854 WARNING_COUNT (&A68G_JOB)++;
855 } else {
856 ERROR_COUNT (&A68G_JOB)++;
857 }
858 if (p == NO_NODE) {
859 if (line == NO_LINE) {
860 write_diagnostic (sev, b);
861 } else {
862 add_diagnostic (line, pos, NO_NODE, sev, b);
863 }
864 } else {
865 add_diagnostic (NO_LINE, NO_TEXT, p, sev, b);
866 if (sev == A68G_MATH_WARNING && p != NO_NODE && LINE (INFO (p)) != NO_LINE) {
867 write_source_line (A68G_STDERR, LINE (INFO (p)), p, A68G_TRUE);
868 WRITE (A68G_STDERR, NEWLINE_STRING);
869 }
870 }
871 }
872 va_end (args);
873 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
