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 (a68_bufprt (txt, SNPRINTF_SIZE, "no information") >= 0);
42 } else {
43 ASSERT (a68_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 (a68_bufprt (txt, (size_t) SMALL_BUFFER_SIZE, "\\^%c", ch + 96) >= 0);
66 } else {
67 ASSERT (a68_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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "%s: exiting: %s: %d: %s", A68 (a68_cmd_name), file, line, reason) >= 0);
121 if (info != NO_TEXT) {
122 a68_bufcat (A68 (output_line), ", ", BUFFER_SIZE);
123 a68_bufcat (A68 (output_line), info, BUFFER_SIZE);
124 }
125 if (errno != 0) {
126 a68_bufcat (A68 (output_line), " (", BUFFER_SIZE);
127 a68_bufcat (A68 (output_line), error_specification (), BUFFER_SIZE);
128 a68_bufcat (A68 (output_line), ")", BUFFER_SIZE);
129 }
130 a68_bufcat (A68 (output_line), "\n", BUFFER_SIZE);
131 io_close_tty_line ();
132 pretty_diag (A68_STDERR, A68 (output_line));
133 a68_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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, " ") >= 0);
200 } else {
201 ASSERT (a68_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 a68_bufcpy (A68 (output_line), "", BUFFER_SIZE);
215 line_ended = A68_TRUE;
216 } else {
217 if (IS_GRAPH (c[0])) {
218 char *c1;
219 a68_bufcpy (A68 (output_line), "", BUFFER_SIZE);
220 for (c1 = c; IS_GRAPH (c1[0]) && len <= line_width - 5; c1++, len++) {
221 a68_bufcat (A68 (output_line), char_to_str (c1[0]), BUFFER_SIZE);
222 }
223 if (len > line_width - 5) {
224 a68_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 a68_bufcpy (A68 (output_line), "", BUFFER_SIZE);
234 while (n--) {
235 a68_bufcat (A68 (output_line), " ", BUFFER_SIZE);
236 }
237 new_pos = &c[1];
238 } else if (unprintable (c[0])) {
239 a68_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 a68_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 a68_bufcpy (A68 (output_line), "-", BUFFER_SIZE);
286 } else if (diags_at_this_pos != 0) {
287 if (mask == A68_NO_DIAGNOSTICS) {
288 a68_bufcpy (A68 (output_line), " ", BUFFER_SIZE);
289 } else if (diags_at_this_pos == 1) {
290 ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "%c", digchar (k)) >= 0);
291 } else {
292 a68_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 a68_bufcpy (A68 (output_line), "", BUFFER_SIZE);
299 while (n--) {
300 a68_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 a68_bufcpy (A68 (output_line), "", BUFFER_SIZE);
306 while (n--) {
307 a68_bufcat (A68 (output_line), " ", BUFFER_SIZE);
308 }
309 } else {
310 a68_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 (a68_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_SUPPRESS_SEVERITY)));
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_SUPPRESS_SEVERITY, NO_NODE, txt, u, v, error_specification ());
379 } else {
380 diagnostic (A68_SUPPRESS_SEVERITY, 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 = a68_alloc(len, __FILE__, __LINE__);
390 ABEND (txti == NO_TEXT, ERROR_OUT_OF_CORE, __func__);
391 a68_bufcpy (txti, txt, len);
392 a68_bufcat (txti, " Z", len);
393 if (errno != 0) {
394 diagnostic (A68_SUPPRESS_SEVERITY, NO_NODE, txti, u, v, info, error_specification ());
395 } else {
396 diagnostic (A68_SUPPRESS_SEVERITY, 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_SUPPRESS_SEVERITY, NO_NODE, txt, u, v, error_specification ());
410 } else {
411 diagnostic (A68_SUPPRESS_SEVERITY, 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_SUPPRESS_SEVERITY: {
439 return NO_TEXT;
440 }
441 default: {
442 return NO_TEXT;
443 }
444 }
445 }
446
447 //! @brief Print diagnostic.
448
449 void write_diagnostic (int sev, char *b)
450 {
451 char txt[SMALL_BUFFER_SIZE];
452 char *severity = get_severity (sev);
453 if (severity == NO_TEXT) {
454 ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "%s: %s.", A68 (a68_cmd_name), b) >= 0);
455 } else {
456 a68_bufcpy (txt, get_severity (sev), SMALL_BUFFER_SIZE);
457 ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "%s: %s: %s.", A68 (a68_cmd_name), txt, b) >= 0);
458 }
459 io_close_tty_line ();
460 pretty_diag (A68_STDERR, A68 (output_line));
461 }
462
463 //! @brief Add diagnostic to source line.
464
465 void add_diagnostic (LINE_T * line, char *pos, NODE_T * p, int sev, char *b)
466 {
467 // Add diagnostic and choose GNU style or non-GNU style.
468 DIAGNOSTIC_T *msg = (DIAGNOSTIC_T *) get_heap_space ((size_t) SIZE_ALIGNED (DIAGNOSTIC_T));
469 DIAGNOSTIC_T **ref_msg;
470 BUFFER a, nst;
471 char st[SMALL_BUFFER_SIZE];
472 char *severity = get_severity (sev);
473 int k = 1;
474 if (line == NO_LINE && p == NO_NODE) {
475 return;
476 }
477 if (A68 (in_monitor)) {
478 monitor_error (b, NO_TEXT);
479 return;
480 }
481 nst[0] = NULL_CHAR;
482 if (line == NO_LINE && p != NO_NODE) {
483 line = LINE (INFO (p));
484 }
485 while (line != NO_LINE && NUMBER (line) == 0) {
486 FORWARD (line);
487 }
488 if (line == NO_LINE) {
489 return;
490 }
491 ref_msg = &(DIAGNOSTICS (line));
492 while (*ref_msg != NO_DIAGNOSTIC) {
493 ref_msg = &(NEXT (*ref_msg));
494 k++;
495 }
496 if (p != NO_NODE) {
497 NODE_T *n = NEST (p);
498 if (n != NO_NODE && NSYMBOL (n) != NO_TEXT) {
499 char *nt = non_terminal_string (A68 (edit_line), ATTRIBUTE (n));
500 if (nt != NO_TEXT) {
501 if (LINE_NUMBER (n) == 0) {
502 ASSERT (a68_bufprt (nst, SNPRINTF_SIZE, ", in %s", nt) >= 0);
503 } else {
504 if (MOID (n) != NO_MOID) {
505 if (LINE_NUMBER (n) == NUMBER (line)) {
506 ASSERT (a68_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);
507 } else {
508 ASSERT (a68_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);
509 }
510 } else {
511 if (LINE_NUMBER (n) == NUMBER (line)) {
512 ASSERT (a68_bufprt (nst, SNPRINTF_SIZE, ", in %s starting at \"%.64s\" in this line", nt, NSYMBOL (n)) >= 0);
513 } else {
514 ASSERT (a68_bufprt (nst, SNPRINTF_SIZE, ", in %s starting at \"%.64s\" in line %d", nt, NSYMBOL (n), LINE_NUMBER (n)) >= 0);
515 }
516 }
517 }
518 }
519 }
520 }
521 if (severity == NO_TEXT) {
522 if (FILENAME (line) != NO_TEXT && strcmp (FILE_SOURCE_NAME (&A68_JOB), FILENAME (line)) == 0) {
523 ASSERT (a68_bufprt (a, SNPRINTF_SIZE, "%s: %x: %s", A68 (a68_cmd_name), (unt) k, b) >= 0);
524 } else if (FILENAME (line) != NO_TEXT) {
525 ASSERT (a68_bufprt (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68 (a68_cmd_name), FILENAME (line), (unt) k, b) >= 0);
526 } else {
527 ASSERT (a68_bufprt (a, SNPRINTF_SIZE, "%s: %x: %s", A68 (a68_cmd_name), (unt) k, b) >= 0);
528 }
529 } else {
530 a68_bufcpy (st, get_severity (sev), SMALL_BUFFER_SIZE);
531 if (FILENAME (line) != NO_TEXT && strcmp (FILE_SOURCE_NAME (&A68_JOB), FILENAME (line)) == 0) {
532 ASSERT (a68_bufprt (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68 (a68_cmd_name), st, (unt) k, b) >= 0);
533 } else if (FILENAME (line) != NO_TEXT) {
534 ASSERT (a68_bufprt (a, SNPRINTF_SIZE, "%s: %s: %s: %x: %s", A68 (a68_cmd_name), FILENAME (line), st, (unt) k, b) >= 0);
535 } else {
536 ASSERT (a68_bufprt (a, SNPRINTF_SIZE, "%s: %s: %x: %s", A68 (a68_cmd_name), st, (unt) k, b) >= 0);
537 }
538 }
539 // cppcheck might complain here but this memory is not returned, for obvious reasons.
540 *ref_msg = msg;
541 ATTRIBUTE (msg) = sev;
542 if (nst[0] != NULL_CHAR) {
543 a68_bufcat (a, nst, BUFFER_SIZE);
544 }
545 a68_bufcat (a, ".", BUFFER_SIZE);
546 TEXT (msg) = new_string (a, NO_TEXT);
547 WHERE (msg) = p;
548 LINE (msg) = line;
549 SYMBOL (msg) = pos;
550 NUMBER (msg) = k;
551 NEXT (msg) = NO_DIAGNOSTIC;
552 }
553
554 //! @brief Give a diagnostic message.
555
556 void diagnostic (STATUS_MASK_T sev, NODE_T * p, char *loc_str, ...)
557 {
558 va_list args;
559 MOID_T *moid = NO_MOID;
560 char *t = loc_str, b[BUFFER_SIZE];
561 BOOL_T force, compose = A68_TRUE, issue = A68_TRUE;
562 va_start (args, loc_str);
563 b[0] = NULL_CHAR;
564 force = (BOOL_T) ((sev & A68_FORCE_DIAGNOSTICS) != 0);
565 sev &= ~A68_FORCE_DIAGNOSTICS;
566 // Node or line?
567 LINE_T *line = NO_LINE;
568 char *pos = NO_TEXT;
569 if (p == NO_NODE) {
570 line = va_arg (args, LINE_T *);
571 pos = va_arg (args, char *);
572 }
573 // No warnings?
574 if (!force && sev == A68_WARNING && OPTION_NO_WARNINGS (&A68_JOB)) {
575 va_end (args);
576 return;
577 }
578 if (!force && sev == A68_MATH_WARNING && OPTION_NO_WARNINGS (&A68_JOB)) {
579 va_end (args);
580 return;
581 }
582 if (sev == A68_WARNING && OPTION_QUIET (&A68_JOB)) {
583 va_end (args);
584 return;
585 }
586 if (sev == A68_MATH_WARNING && OPTION_QUIET (&A68_JOB)) {
587 va_end (args);
588 return;
589 }
590 // Suppressed?.
591 if (sev == A68_ERROR || sev == A68_SYNTAX_ERROR) {
592 if (ERROR_COUNT (&A68_JOB) == MAX_ERRORS) {
593 a68_bufcpy (b, "further diagnostics suppressed", BUFFER_SIZE);
594 compose = A68_FALSE;
595 sev = A68_ERROR;
596 } else if (ERROR_COUNT (&A68_JOB) > MAX_ERRORS) {
597 ERROR_COUNT (&A68_JOB)++;
598 compose = issue = A68_FALSE;
599 }
600 } else if (sev == A68_WARNING || sev == A68_MATH_WARNING) {
601 if (WARNING_COUNT (&A68_JOB) == MAX_ERRORS) {
602 a68_bufcpy (b, "further diagnostics suppressed", BUFFER_SIZE);
603 compose = A68_FALSE;
604 } else if (WARNING_COUNT (&A68_JOB) > MAX_ERRORS) {
605 WARNING_COUNT (&A68_JOB)++;
606 compose = issue = A68_FALSE;
607 }
608 }
609 if (compose) {
610 // Synthesize diagnostic message.
611 if ((sev & A68_NO_SYNTHESIS) != NULL_MASK) {
612 sev &= ~A68_NO_SYNTHESIS;
613 a68_bufcat (b, t, BUFFER_SIZE);
614 } else {
615 // Legend for special symbols:
616 // * as first character, copy rest of string literally
617 // # skip extra syntactical information
618 // @ non terminal
619 // A non terminal
620 // B keyword
621 // C context
622 // D argument in decimal
623 // H char argument
624 // K 'LONG'
625 // L line number
626 // M moid - if error mode return without giving a message
627 // N mode - M_NIL
628 // O moid - operand
629 // S quoted symbol, when possible with typographical display features
630 // X expected attribute
631 // Y string literal.
632 // Z quoted string literal.
633 if (t[0] == '*') {
634 a68_bufcat (b, &t[1], BUFFER_SIZE);
635 } else
636 while (t[0] != NULL_CHAR) {
637 if (t[0] == '#') {
638 ;
639 } else if (t[0] == '@') {
640 if (p == NO_NODE) {
641 a68_bufcat (b, "construct", BUFFER_SIZE);
642 } else {
643 char *nt = non_terminal_string (A68 (edit_line), ATTRIBUTE (p));
644 if (t != NO_TEXT) {
645 a68_bufcat (b, nt, BUFFER_SIZE);
646 } else {
647 a68_bufcat (b, "construct", BUFFER_SIZE);
648 }
649 }
650 } else if (t[0] == 'A') {
651 int att = va_arg (args, int);
652 char *nt = non_terminal_string (A68 (edit_line), att);
653 if (nt != NO_TEXT) {
654 a68_bufcat (b, nt, BUFFER_SIZE);
655 } else {
656 a68_bufcat (b, "construct", BUFFER_SIZE);
657 }
658 } else if (t[0] == 'B') {
659 int att = va_arg (args, int);
660 KEYWORD_T *nt = find_keyword_from_attribute (A68 (top_keyword), att);
661 if (nt != NO_KEYWORD) {
662 a68_bufcat (b, "\"", BUFFER_SIZE);
663 a68_bufcat (b, TEXT (nt), BUFFER_SIZE);
664 a68_bufcat (b, "\"", BUFFER_SIZE);
665 } else {
666 a68_bufcat (b, "keyword", BUFFER_SIZE);
667 }
668 } else if (t[0] == 'C') {
669 int att = va_arg (args, int);
670 if (att == NO_SORT) {
671 a68_bufcat (b, "this", BUFFER_SIZE);
672 }
673 if (att == SOFT) {
674 a68_bufcat (b, "a soft", BUFFER_SIZE);
675 } else if (att == WEAK) {
676 a68_bufcat (b, "a weak", BUFFER_SIZE);
677 } else if (att == MEEK) {
678 a68_bufcat (b, "a meek", BUFFER_SIZE);
679 } else if (att == FIRM) {
680 a68_bufcat (b, "a firm", BUFFER_SIZE);
681 } else if (att == STRONG) {
682 a68_bufcat (b, "a strong", BUFFER_SIZE);
683 }
684 } else if (t[0] == 'D') {
685 int a = va_arg (args, int);
686 BUFFER d;
687 BUFCLR (d);
688 ASSERT (a68_bufprt (d, SNPRINTF_SIZE, "%d", a) >= 0);
689 a68_bufcat (b, d, BUFFER_SIZE);
690 } else if (t[0] == 'H') {
691 char *a = va_arg (args, char *);
692 char d[SMALL_BUFFER_SIZE];
693 ASSERT (a68_bufprt (d, (size_t) SMALL_BUFFER_SIZE, "\"%c\"", a[0]) >= 0);
694 a68_bufcat (b, d, BUFFER_SIZE);
695 } else if (t[0] == 'K') {
696 a68_bufcat (b, "LONG", BUFFER_SIZE);
697 } else if (t[0] == 'L') {
698 LINE_T *a = va_arg (args, LINE_T *);
699 char d[SMALL_BUFFER_SIZE];
700 ABEND (a == NO_LINE, ERROR_INTERNAL_CONSISTENCY, __func__);
701 if (NUMBER (a) == 0) {
702 a68_bufcat (b, "in standard environment", BUFFER_SIZE);
703 } else {
704 if (p != NO_NODE && NUMBER (a) == LINE_NUMBER (p)) {
705 ASSERT (a68_bufprt (d, (size_t) SMALL_BUFFER_SIZE, "in this line") >= 0);
706 } else {
707 ASSERT (a68_bufprt (d, (size_t) SMALL_BUFFER_SIZE, "in line %d", NUMBER (a)) >= 0);
708 }
709 a68_bufcat (b, d, BUFFER_SIZE);
710 }
711 } else if (t[0] == 'M') {
712 moid = va_arg (args, MOID_T *);
713 if (moid == NO_MOID || moid == M_ERROR) {
714 moid = M_UNDEFINED;
715 }
716 if (IS (moid, SERIES_MODE)) {
717 if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) {
718 a68_bufcat (b, moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE);
719 } else {
720 a68_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
721 }
722 } else {
723 a68_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
724 }
725 } else if (t[0] == 'N') {
726 a68_bufcat (b, "NIL name of mode ", BUFFER_SIZE);
727 moid = va_arg (args, MOID_T *);
728 if (moid != NO_MOID) {
729 a68_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
730 }
731 } else if (t[0] == 'O') {
732 moid = va_arg (args, MOID_T *);
733 if (moid == NO_MOID || moid == M_ERROR) {
734 moid = M_UNDEFINED;
735 }
736 if (moid == M_VOID) {
737 a68_bufcat (b, "UNION (VOID, ..)", BUFFER_SIZE);
738 } else if (IS (moid, SERIES_MODE)) {
739 if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) {
740 a68_bufcat (b, moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE);
741 } else {
742 a68_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
743 }
744 } else {
745 a68_bufcat (b, moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
746 }
747 } else if (t[0] == 'S') {
748 if (p != NO_NODE && NSYMBOL (p) != NO_TEXT) {
749 char *txt = NSYMBOL (p);
750 char *sym = NCHAR_IN_LINE (p);
751 int n = 0, size = (int) strlen (txt);
752 a68_bufcat (b, "\"", BUFFER_SIZE);
753 if (txt[0] != sym[0] || (int) strlen (sym) < size) {
754 a68_bufcat (b, txt, BUFFER_SIZE);
755 } else {
756 while (n < size) {
757 if (IS_PRINT (sym[0])) {
758 char str[2];
759 str[0] = sym[0];
760 str[1] = NULL_CHAR;
761 a68_bufcat (b, str, BUFFER_SIZE);
762 }
763 if (TO_LOWER (txt[0]) == TO_LOWER (sym[0])) {
764 txt++;
765 n++;
766 }
767 sym++;
768 }
769 }
770 a68_bufcat (b, "\"", BUFFER_SIZE);
771 } else {
772 a68_bufcat (b, "symbol", BUFFER_SIZE);
773 }
774 } else if (t[0] == 'V') {
775 a68_bufcat (b, PACKAGE_STRING, BUFFER_SIZE);
776 } else if (t[0] == 'X') {
777 int att = va_arg (args, int);
778 BUFFER z;
779 (void) non_terminal_string (z, att);
780 a68_bufcat (b, new_string (z, NO_TEXT), BUFFER_SIZE);
781 } else if (t[0] == 'Y') {
782 char *loc_string = va_arg (args, char *);
783 if (loc_string != NO_TEXT) {
784 a68_bufcat (b, loc_string, BUFFER_SIZE);
785 }
786 } else if (t[0] == 'Z') {
787 char *loc_string = va_arg (args, char *);
788 a68_bufcat (b, "\"", BUFFER_SIZE);
789 if (loc_string != NO_TEXT) {
790 a68_bufcat (b, loc_string, BUFFER_SIZE);
791 }
792 a68_bufcat (b, "\"", BUFFER_SIZE);
793 } else {
794 char q[2];
795 q[0] = t[0];
796 q[1] = NULL_CHAR;
797 a68_bufcat (b, q, BUFFER_SIZE);
798 }
799 t++;
800 }
801 // Add information from errno, if any.
802 if (errno != 0) {
803 char *loc_str2 = new_string (error_specification (), NO_TEXT);
804 if (loc_str2 != NO_TEXT) {
805 char *stu;
806 a68_bufcat (b, ", ", BUFFER_SIZE);
807 for (stu = loc_str2; stu[0] != NULL_CHAR; stu++) {
808 stu[0] = (char) TO_LOWER (stu[0]);
809 }
810 a68_bufcat (b, loc_str2, BUFFER_SIZE);
811 }
812 }
813 }
814 }
815 // Construct a diagnostic message.
816 if (issue) {
817 if (sev == A68_WARNING) {
818 WARNING_COUNT (&A68_JOB)++;
819 } else {
820 ERROR_COUNT (&A68_JOB)++;
821 }
822 if (p == NO_NODE) {
823 if (line == NO_LINE) {
824 write_diagnostic (sev, b);
825 } else {
826 add_diagnostic (line, pos, NO_NODE, sev, b);
827 }
828 } else {
829 add_diagnostic (NO_LINE, NO_TEXT, p, sev, b);
830 if (sev == A68_MATH_WARNING && p != NO_NODE && LINE (INFO (p)) != NO_LINE) {
831 write_source_line (A68_STDERR, LINE (INFO (p)), p, A68_TRUE);
832 WRITE (A68_STDERR, NEWLINE_STRING);
833 }
834 }
835 }
836 va_end (args);
837 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
