Algol 68 Genie

autosave.c

     
   1  //! @file autosave.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  //! Compile storage classes, SAVE statement.
  25  
  26  #include <vif.h>
  27  
  28  static void save_all (void)
  29  {
  30    int_4 k;
  31    for (k = 0; k < nlocals; k++) {
  32      IDENT *idf = &locals[k];
  33      if (idf->arg) {
  34        ;
  35      } else if (idf->common != LOCAL) {
  36        ;
  37      } else if (idf->external) {
  38        ;
  39      } else if (idf->alias != NULL && idf->alias->save == AUTOMATIC) {
  40        ;
  41      } else if (idf->equiv != NULL && idf->equiv->save == AUTOMATIC) {
  42        ;
  43      } else {
  44        idf->mode.save = STATIC;
  45      }
  46    }
  47  }
  48  
  49  static void auto_all (void)
  50  {
  51    int_4 k;
  52    for (k = 0; k < nlocals; k++) {
  53      IDENT *idf = &locals[k];
  54      if (idf->arg) {
  55        ;
  56      } else if (idf->common != LOCAL) {
  57        ;
  58      } else if (idf->external) {
  59        ;
  60      } else if (idf->alias != NULL && idf->alias->save == STATIC) {
  61        ;
  62      } else if (idf->equiv != NULL && idf->equiv->save == STATIC) {
  63        ;
  64      } else {
  65        idf->mode.save = AUTOMATIC;
  66      }
  67    }
  68  }
  69  
  70  void save (void)
  71  {
  72    int_4 rc;
  73    if ((rc = scan (NULL)) == END_OF_LINE) {
  74      save_all ();
  75      return;
  76    } else {
  77      UNSCAN;
  78    } 
  79    while ((rc = scan (NULL)) != END_OF_LINE) {
  80      if (TOKEN (",")) {
  81        ;
  82      } else if (rc == WORD) {
  83        IDENT *idf = void_decl (curlex, NULL);
  84        if (idf->arg) {
  85          ERROR (201, "variable is an argument", CID (idf));
  86        } else if (idf->common != LOCAL) {
  87          ERROR (202, "variable is in common block", CID (idf));
  88        } else if (idf->external) {
  89          ERROR (203, "variable is external", CID (idf));
  90        } else if (idf->alias != NULL && idf->alias->save == AUTOMATIC) {
  91          ERROR (204, "equivalenced to automatic storage", CID (idf));
  92        } else if (idf->equiv != NULL && idf->equiv->save == AUTOMATIC) {
  93          ERROR (205, "equivalenced to automatic storage", CID (idf));
  94        } else {
  95          idf->mode.save = STATIC;
  96        }
  97      } else if (TOKEN ("/")) {
  98        rc = scan (NULL);
  99        if (rc != WORD) {
 100          SYNTAX (206, "common block name");
 101        } else {
 102          ; // Common block name is allowed but ignored in F77 ...
 103        }
 104        rc = scan ("/");
 105      } else {
 106        EXPECT (207, "variable name");
 107      }
 108    }
 109  }
 110  
 111  void automatic (void)
 112  {
 113    int_4 rc;
 114    if ((rc = scan (NULL)) == END_OF_LINE) {
 115      auto_all ();
 116      return;
 117    } else {
 118      UNSCAN;
 119    } 
 120    while ((rc = scan (NULL)) != END_OF_LINE) {
 121      if (TOKEN (",")) {
 122        ;
 123      } else if (rc == WORD) {
 124        IDENT *idf = void_decl (curlex, NULL);
 125        if (idf->arg) {
 126          ERROR (208, "variable is an argument", CID (idf));
 127        } else if (idf->common != LOCAL) {
 128          ERROR (209, "variable is in common block", CID (idf));
 129        } else if (idf->external) {
 130          ERROR (210, "variable is external", CID (idf));
 131        } else if (idf->alias != NULL && idf->alias->save == STATIC) {
 132          ERROR (211, "equivalenced to static storage", CID (idf));
 133        } else if (idf->equiv != NULL && idf->equiv->save == STATIC) {
 134          ERROR (212, "equivalenced to static storage", CID (idf));
 135        } else {
 136          idf->mode.save = AUTOMATIC;
 137        }
 138      } else {
 139        EXPECT (213, "variable name");
 140      }
 141    }
 142  }
 143  
 144  void decl_autosave (void)
 145  {
 146    int_4 go_on = TRUE;
 147    while (go_on) {
 148      SAVE_POS;
 149      int_4 rc = scan (NULL);
 150      if (rc == DECLAR) {
 151        skip_card ();
 152      } else if (TOKEN ("implicit")) {
 153        skip_card ();
 154      } else if (TOKEN ("save")) {
 155        save ();
 156        skip_card ();
 157      } else if (TOKEN ("automatic")) {
 158        automatic ();
 159        skip_card ();
 160      } else if (TOKEN ("parameter")) {
 161        skip_card ();
 162      } else if (TOKEN ("common")) {
 163        skip_card ();
 164      } else if (TOKEN ("dimension")) {
 165        skip_card ();
 166      } else if (TOKEN ("equivalence")) {
 167        skip_card ();
 168      } else if (TOKEN ("external")) {
 169        skip_card ();
 170      } else if (TOKEN ("intrinsic")) {
 171        skip_card ();
 172      } else if (TOKEN ("data")) {
 173        skip_card ();
 174      } else if (strlen (curlex) > 0) {
 175  // Backspace and done.
 176        RESTORE_POS;
 177        go_on = FALSE;
 178      }
 179    }
 180  }
 181
Deze website is gearchiveerd door de KB, nationale bibliotheek.

This website is archived by the National Library of the Netherlands.