decide.c

     1  //! @file decide.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-2025 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  //! Decide statement type.
    25  
    26  #include <vif.h>
    27  
    28  int_4 statement_type (void)
    29  {
    30  // FORTRAN allowed to use a keyword as variable name.
    31  // The meaning of a keyword thus depended on its use.
    32  // Most code does not use this feature, presumably for portability reasons.
    33  // Sometimes code uses IF, SAVE or DATA as variable name.
    34  // Below code determines whether a line is either
    35  //
    36  //   1. An ASSIGNMENT, for instance DATA = 1 or IF (1) = 0
    37  //   2. A MACRO_DECLARATION, for instance SAVE (X) = SIN(X * PI / 180.0)
    38  //   3. A STATEMENT, that is, neither (1) nor (2).
    39  //
    40    SAVE_POS (1);
    41    NEW_RECORD (name);
    42    RECCPY (name, curlex);
    43    int_4 rc = scan (NULL);
    44    if (TOKEN ("=")) {
    45      RESTORE_POS (1);
    46      return ASSIGNMENT;
    47    } else if (TOKEN ("(")) {
    48      int_4 nest = 1;
    49      while (TRUE) {
    50        rc = scan (NULL);
    51        if (rc == END_OF_LINE || rc == END_OF_MODULE) {
    52          RESTORE_POS (1);
    53          return NOT_ASSIGNMENT;
    54        } else if (TOKEN ("(")) {
    55          nest++;
    56        } else if (TOKEN (")")) {
    57          nest--;
    58          if (nest == 0) {
    59            rc = scan (NULL);
    60            if (TOKEN ("=")) {
    61              MODE mode;
    62              IDENT *idf = find_local (name, &mode);
    63              if (idf == NO_IDENT || (!idf->external && !idf->parm && !IS_ROW (idf->mode))) {
    64                RESTORE_POS (1);
    65                return MACRO_DECLARATION;
    66              } else {
    67                RESTORE_POS (1);
    68                return ASSIGNMENT;
    69              }
    70            } else {
    71              RESTORE_POS (1);
    72              return NOT_ASSIGNMENT;
    73            }
    74          }
    75        }
    76      } 
    77    } else {
    78      RESTORE_POS (1);
    79      return NOT_ASSIGNMENT;
    80    }
    81  }


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