//! @file autosave.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
//!
//! Compile SAVE.

#include <vif.h>

static void save_all (void)
{
  int_4 k;
  for (k = 0; k < nlocals; k++) {
    IDENT *idf = &locals[k];
    if (idf->arg) {
      ;
    } else if (idf->common != LOCAL) {
      ;
    } else if (idf->external) {
      ;
    } else if (idf->alias != NO_IDENT && idf->alias->save == AUTOMATIC) {
      ;
    } else if (idf->equiv != NO_IDENT && idf->equiv->save == AUTOMATIC) {
      ;
    } else {
      idf->mode.save = STATIC;
    }
  }
}

static void auto_all (void)
{
  int_4 k;
  for (k = 0; k < nlocals; k++) {
    IDENT *idf = &locals[k];
    if (idf->arg) {
      ;
    } else if (idf->common != LOCAL) {
      ;
    } else if (idf->external) {
      ;
    } else if (idf->alias != NO_IDENT && idf->alias->save == STATIC) {
      ;
    } else if (idf->equiv != NO_IDENT && idf->equiv->save == STATIC) {
      ;
    } else {
      idf->mode.save = AUTOMATIC;
    }
  }
}

void save (void)
{
  int_4 rc;
  if ((rc = scan (EXPECT_NONE)) == END_OF_LINE) {
    save_all ();
    return;
  } else {
    UNSCAN;
  } 
  while ((rc = scan (EXPECT_NONE)) != END_OF_LINE) {
    if (TOKEN (",")) {
      ;
    } else if (rc == WORD) {
      IDENT *idf = void_decl (curlex, NO_MODE);
      if (idf->arg) {
        ERROR (201, "variable is an argument", F_NAME (idf));
      } else if (idf->common != LOCAL) {
        ERROR (202, "variable is in common block", F_NAME (idf));
      } else if (idf->external) {
        ERROR (203, "variable is external", F_NAME (idf));
      } else if (idf->alias != NO_IDENT && idf->alias->save == AUTOMATIC) {
        ERROR (204, "equivalenced to automatic storage", F_NAME (idf));
      } else if (idf->equiv != NO_IDENT && idf->equiv->save == AUTOMATIC) {
        ERROR (205, "equivalenced to automatic storage", F_NAME (idf));
      } else {
        idf->mode.save = STATIC;
      }
    } else if (TOKEN ("/")) {
      rc = scan (EXPECT_NONE);
      if (rc != WORD) {
        SYNTAX (206, "common block name");
      } else {
        ; // Common block name is allowed but ignored in F77 ...
      }
      rc = scan ("/");
    } else {
      EXPECT (207, "variable name");
    }
  }
}

void automatic (void)
{
  int_4 rc;
  if ((rc = scan (EXPECT_NONE)) == END_OF_LINE) {
    auto_all ();
    return;
  } else {
    UNSCAN;
  } 
  while ((rc = scan (EXPECT_NONE)) != END_OF_LINE) {
    if (TOKEN (",")) {
      ;
    } else if (rc == WORD) {
      IDENT *idf = void_decl (curlex, NO_MODE);
      if (idf->arg) {
        ERROR (208, "variable is an argument", F_NAME (idf));
      } else if (idf->common != LOCAL) {
        ERROR (209, "variable is in common block", F_NAME (idf));
      } else if (idf->external) {
        ERROR (210, "variable is external", F_NAME (idf));
      } else if (idf->alias != NO_IDENT && idf->alias->save == STATIC) {
        ERROR (211, "equivalenced to static storage", F_NAME (idf));
      } else if (idf->equiv != NO_IDENT && idf->equiv->save == STATIC) {
        ERROR (212, "equivalenced to static storage", F_NAME (idf));
      } else {
        idf->mode.save = AUTOMATIC;
      }
    } else {
      EXPECT (213, "variable name");
    }
  }
}

void decl_autosave (void)
{
  int_4 go_on = TRUE;
  while (go_on) {
    SAVE_POS (1);
    int_4 rc = scan (EXPECT_NONE);
    if (rc == DECLAR) {
      skip_card (FALSE);
    } else if (TOKEN ("implicit") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("save") && IS_NOT_ASSIGNMENT) {
      save ();
      skip_card (FALSE);
    } else if (TOKEN ("automatic") && IS_NOT_ASSIGNMENT) {
      automatic ();
      skip_card (FALSE);
    } else if (TOKEN ("parameter") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("common") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("dimension") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("equivalence") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("external") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("intrinsic") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("data") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (rc == WORD && IS_MACRO_DECLARATION) {
      skip_card (FALSE);
    } else if (strlen (curlex) > 0) {
// Backspace and done.
      RESTORE_POS (1);
      go_on = FALSE;
    }
  }
}

