parameter.c

     1  //! @file parameter.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  //! Compile PARAMETER.
    25  
    26  #include <vif.h>
    27  
    28  void parameter (void)
    29  {
    30    int_4 rc, go_on = TRUE;
    31    rc = scan (EXPECT_NONE);
    32    if (!TOKEN ("(")) {
    33      EXPECT (2701, "(");
    34      return;
    35    }
    36    while (go_on) {
    37      rc = scan (EXPECT_NONE);
    38      if (TOKEN (")")) {
    39        break;
    40      }
    41      if (rc != WORD) {
    42        EXPECT (2702, "variable");
    43      }
    44      // IBM VS Fortran - idf must have been specified, explicitly or implicitly.
    45      MODE mode;
    46      IDENT *idf = impl_decl (curlex, &mode);
    47      rc = scan ("=");
    48      rc = scan (EXPECT_NONE);
    49      EXPR reg;
    50      macro_depth = 0;
    51      express (&reg, mode.type, mode.len);
    52      if (reg.variant == EXPR_CONST) {
    53        idf->parm = f_stralloc (reg.str);
    54        if (idf->mode.type == NOTYPE) {
    55          idf->mode = reg.mode;
    56        }
    57        // Write constant in the listing file.
    58        NEW_RECORD (fold);
    59        snprintf (fold, RECLN, "// %s = %s", C_NAME(idf), idf->parm);
    60        code (nprocs, PARAMETERS, fold); 
    61      } else {
    62        EXPECT (2703, "constant");
    63      }
    64      rc = scan (EXPECT_NONE);
    65      if (TOKEN (",")) {
    66        continue;
    67      } else if (TOKEN (")")) {
    68        go_on = FALSE;
    69      } else {
    70        EXPECT (2704, ", or )");
    71        go_on = FALSE;
    72      }
    73    }
    74    (void) rc;
    75  }


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