//! @file diag.c
//! @author J. Marcel van der Veer
//
//! @section Copyright
//
// This file is part of VIF - vintage FORTRAN compiler.
// Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
//
//! @section License
//
// This program is free software; you can redistribute it and/or modify it 
// under the terms of the GNU General Public License as published by the 
// Free Software Foundation; either version 3 of the License, or 
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful, but 
// WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
// more details. You should have received a copy of the GNU General Public 
// License along with this program. If not, see <http://www.gnu.org/licenses/>.

//! @section Synopsis
//!
//! Diagnostic message routines.

#include <vif.h>

int_4 nerrors = 0, merrors = 0, nwarns = 0;

void diagnostic (int_4 proc, char *msg)
{
  NEW_RECORD (tmp);
  fprintf (stderr, "%s\n", msg);
  _srecordf (tmp, "// %s", msg);
  code (proc, MESSAGES, tmp);
}

void message (FTN_LINE * flin, int_4 pos, char *sev, int num, char *pre, char *post)
{
  if (EQUAL (sev, "error")) {
    if (merrors++ > MAX_ERROR) {
      return;
    }
    nerrors++;
    if (flin != NO_FTN_LINE && flin->diag > 0) {
      flin->diag++;
      return;
    } else {
      flin->diag++;
    }
  } else if (EQUAL (sev, "warning")) {
    if (no_warnings) {
      return;
    }
    if (nwarns++ > MAX_WARNS) {
      return;
    }
  }
  NEW_RECORD (msg); NEW_RECORD (tmp);
  RECCLR (msg);
  if (flin != NO_FTN_LINE && flin->file != NO_FTN_LINE && flin->isn > 0) {
    _srecordf (tmp, "** %-10s ** isn %d: ", modnam, flin->isn);
    bufcat (msg, tmp, RECLN);
  } else {
    _srecordf (tmp, "** %-10s ** ", modnam);
    bufcat (msg, tmp, RECLN);
  }
  if (sev != NO_TEXT) {
    if (num > 0) {
      _srecordf (tmp, "%s (%04d)", sev, num);
    } else {
      _srecordf (tmp, "%s", sev);
    }
    bufcat (msg, tmp, RECLN);
  }
  if (pre != NO_TEXT) {
    _srecordf (tmp, ": %s", pre);
    bufcat (msg, tmp, RECLN);
  }
  if (post != NO_TEXT) {
    _srecordf (tmp, ": %s", post);
    bufcat (msg, tmp, RECLN);
  }
  if (flin == NO_FTN_LINE) {
    diagnostic (0, msg);
  } else {
    if (flin->file != NO_FTN_LINE && flin->file->text != NO_TEXT && flin->isn > 0) {
      _srecordf (tmp, "** %-10s ** isn %d: %s", modnam, flin->isn, flin->text);
      diagnostic (nprocs, tmp);
    }
    diagnostic (nprocs, msg);
  }
}
