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