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    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    RECORD msg, 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)