//! @file fpp.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
//!
//! Fortran preprocessor.

#include <vif.h>

void fpp (char *, char *, int_4 nest);

int_4 register_file(char *name)
{
  for (int_4 k = 1; k <= nfiles; k++) {
    if (strcmp (files[k].text, name) == 0) {
       return k;
    }
  }
  nfiles++;
  if (nfiles >= MAX_SOURCE_FILES) {
    FATAL (2001, "too many source files", NO_TEXT);
  }
  files[nfiles].num = nfiles;
  files[nfiles].text = f_stralloc (name);
  return nfiles;
}

void get_source (char *name, int_4 nest)
{
  FILE *in;
  char *ext;
  int_4 lines = 1, nisn = 0, actfile, cntrls = 0;
  if (nest > MAX_NEST) {
    FATAL (2002, "include nesting too deep", name);
  }
  if (strlen (name) < 1) {
    FATAL (2003, "source file name", name);
  }
  ext = &name[strlen (name) - 2];
  if (EQUAL (ext, ".f") || EQUAL (ext, ".F")) {
    ;// Ok
  } else if (EQUAL (ext, ".f66") || EQUAL (ext, ".F66")) {
    ;// Ok
  } else if (EQUAL (ext, ".f77") || EQUAL (ext, ".F77")) {
    ;// Ok
  } else if (EQUAL (ext, ".ftn") || EQUAL (ext, ".FTN")) {
    ;// Ok
  } else if (EQUAL (ext, ".h") || EQUAL (ext, ".H")) {
    ;// Ok
  } else {
    name = f_strallocat (name, ".f");
  }
  if ((in = fopen (name, "r")) == NO_FILE) {
    FATAL (2004, "cannot read", name);
  };
  NEW_RECORD (path);
  _srecordf (path, "%s", dirname (name));
  actfile = register_file(name);
  while (!feof (in)) {
    NEW_RECORD (fetch);
    if (fgets (fetch, RECLN, in) != NO_TEXT) {
      int_4 len = strlen (fetch);
      if (len > 0) {
        for (int k = 0; k < len; k++) {
          if (fetch[k] == EOF || fetch[k] == '\0' || fetch[k] == '\n') {
            ;
          } else if (fetch[k] == '\r' && fetch[k + 1] == '\n') {
// Assume ms-dos that has \r\n line ends.
            fetch[k] = '\n';
            fetch[k + 1] = '\0';
            len--;
          } else {
            if (!isprint (fetch[k])) {
              cntrls++;
              fetch[k] = '?';
            }
          }
        }
        if (fetch[0] == '#') {
          int_4 savfile = actfile;
          fpp (fetch, path, nest);
          actfile = savfile;
          lines++;
        } else {
          if (fetch[len - 1] == '\n') {
            fetch[--len] = '\0';
          }
          if (nftnlines == MAX_FTN_LINES - 1) { // One less - always terminating NULL line.
            MAX_FTN_LINES += INCREMENT;
            source = (FTN_LINE *) f_realloc (source, MAX_FTN_LINES * sizeof (FTN_LINE));
            memset (&source[nftnlines], 0, INCREMENT * sizeof (FTN_LINE));
          }
          source[nftnlines].file = &files[actfile];
          source[nftnlines].num = lines;
          source[nftnlines].len = len;
          source[nftnlines].jcl = FALSE;
          source[nftnlines].text = f_stralloc (fetch);
          if (fetch[0] == '\0' || IS_COMMENT (fetch[0])) {
            source[nftnlines].isn = 0;
          } else if (nisn > 0 && fetch[5] != ' ') {
            source[nftnlines].isn = nisn;
          } else {
            source[nftnlines].isn = ++nisn;
          }
          lines++;
          nftnlines++;
        }
      }
    }
  }
  files[nfiles].len = lines - 1;
  fclose (in);
  if (cntrls > 0) {
    WARNING (2005, "source has unrecognized characters", NO_TEXT);
  }
}

void fpp (char *cmd, char *path, int_4 nest)
{
  if (cmd[0] == '#') {
    cmd++;
  }
  while (cmd[0] == ' ') {
    cmd++;
  }
  if (LEQUAL ("echo", cmd)) {
    cmd = &cmd[strlen ("echo")];
    while (cmd[0] == ' ') {
      cmd++;
    }
    int_4 N = strlen (cmd);
    if (N > 0 && cmd[N - 1] == '\n') {
      cmd[N - 1] = '\0';
    }
    ECHO (2006, cmd, NO_TEXT);
  } else if (LEQUAL ("pragma", cmd)) {
    cmd = &cmd[strlen ("pragma")];
    while (cmd[0] == ' ') {
      cmd++;
    }
    int_4 N = strlen (cmd);
    if (N > 0 && cmd[N - 1] == '\n') {
      cmd[N - 1] = '\0';
    }
    option (cmd);
  } else if (LEQUAL ("include", cmd)) {
    NEW_RECORD (fn);
    (void) strtok (cmd, "'");
    char *str = strtok (NO_TEXT, "'");
    if (str != NO_TEXT) {
      _srecordf (fn, "%s/%s", path, str);
      get_source (fn, nest + 1);
    } else {
      FATAL (2007, "filename required", cmd);
    }
  } else {
    FATAL (2008, "preprocessor directive", cmd);
  }
}
