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