diag.c

     1  //! @file diag.c
     2  //! @author J. Marcel van der Veer
     3  //
     4  //! @section Copyright
     5  //
     6  // This file is part of VIF - vintage FORTRAN compiler.
     7  // Copyright 2020-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  //! Diagnostic message routines.
    25  
    26  #include <vif.h>
    27  
    28  int_4 nerrors = 0, merrors = 0, nwarns = 0;
    29  
    30  void diagnostic (int_4 proc, char *msg)
    31  {
    32    NEW_RECORD (tmp);
    33    fprintf (stderr, "%s\n", msg);
    34    _srecordf (tmp, "// %s", msg);
    35    code (proc, MESSAGES, tmp);
    36  }
    37  
    38  void message (FTN_LINE * flin, int_4 pos, char *sev, int num, char *pre, char *post)
    39  {
    40    if (EQUAL (sev, "error")) {
    41      if (merrors++ > MAX_ERROR) {
    42        return;
    43      }
    44      nerrors++;
    45      if (flin != NO_FTN_LINE && flin->diag > 0) {
    46        flin->diag++;
    47        return;
    48      } else {
    49        flin->diag++;
    50      }
    51    } else if (EQUAL (sev, "warning")) {
    52      if (no_warnings) {
    53        return;
    54      }
    55      if (nwarns++ > MAX_WARNS) {
    56        return;
    57      }
    58    }
    59    NEW_RECORD (msg); NEW_RECORD (tmp);
    60    RECCLR (msg);
    61    if (flin != NO_FTN_LINE && flin->file != NO_FTN_LINE && flin->isn > 0) {
    62      _srecordf (tmp, "** %-10s ** isn %d: ", modnam, flin->isn);
    63      bufcat (msg, tmp, RECLN);
    64    } else {
    65      _srecordf (tmp, "** %-10s ** ", modnam);
    66      bufcat (msg, tmp, RECLN);
    67    }
    68    if (sev != NO_TEXT) {
    69      if (num > 0) {
    70        _srecordf (tmp, "%s (%04d)", sev, num);
    71      } else {
    72        _srecordf (tmp, "%s", sev);
    73      }
    74      bufcat (msg, tmp, RECLN);
    75    }
    76    if (pre != NO_TEXT) {
    77      _srecordf (tmp, ": %s", pre);
    78      bufcat (msg, tmp, RECLN);
    79    }
    80    if (post != NO_TEXT) {
    81      _srecordf (tmp, ": %s", post);
    82      bufcat (msg, tmp, RECLN);
    83    }
    84    if (flin == NO_FTN_LINE) {
    85      diagnostic (0, msg);
    86    } else {
    87      if (flin->file != NO_FTN_LINE && flin->file->text != NO_TEXT && flin->isn > 0) {
    88        _srecordf (tmp, "** %-10s ** isn %d: %s", modnam, flin->isn, flin->text);
    89        diagnostic (nprocs, tmp);
    90      }
    91      diagnostic (nprocs, msg);
    92    }
    93  }


© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)