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-2024 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 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 != NULL && 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 != NULL && flin->file != NULL) {
  62      _srecordf (tmp, "** %-10s ** isn %d ", modnam, flin->isn);
  63      bufcat (msg, tmp, RECLN);
  64    }
  65    if (sev != NULL) {
  66      if (num > 0) {
  67        if (strcmp (sev, "error") == 0) {
  68          _srecordf (tmp, "e%d: %s", num, sev);
  69        } else if (strcmp (sev, "warning") == 0) {
  70          _srecordf (tmp, "w%d: %s", num, sev);
  71        } else if (strcmp (sev, "fatal") == 0) {
  72          _srecordf (tmp, "f%d: %s", num, sev);
  73        } else if (strcmp (sev, "info") == 0) {
  74          _srecordf (tmp, "i%d: %s", num, sev);
  75        } else {
  76          _srecordf (tmp, "d%d: %s", num, sev);
  77        }
  78      } else {
  79        _srecordf (tmp, "%s", sev);
  80      }
  81      bufcat (msg, tmp, RECLN);
  82    }
  83    if (pre != NULL) {
  84      _srecordf (tmp, ": %s", pre);
  85      bufcat (msg, tmp, RECLN);
  86    }
  87    if (post != NULL) {
  88      _srecordf (tmp, ": %s", post);
  89      bufcat (msg, tmp, RECLN);
  90    }
  91    if (flin == NULL) {
  92      diagnostic (0, msg);
  93    } else {
  94      if (flin->file != NULL && flin->file->text != NULL) {
  95        _srecordf (tmp, "** %-10s ** isn %d %s", modnam, flin->isn, flin->text);
  96        diagnostic (nprocs, tmp);
  97      }
  98      diagnostic (nprocs, msg);
  99    }
 100  }
     


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