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      express (&reg, mode.type, mode.len);
    51      if (reg.variant == EXPR_CONST) {
    52        idf->parm = f_stralloc (reg.str);
    53        if (idf->mode.type == NOTYPE) {
    54          idf->mode = reg.mode;
    55        }
    56        // Write constant in the listing file.
    57        NEW_RECORD (fold);
    58        snprintf (fold, RECLN, "// %s = %s", C_NAME(idf), idf->parm);
    59        code (nprocs, PARAMETERS, fold); 
    60      } else {
    61        EXPECT (2703, "constant");
    62      }
    63      rc = scan (EXPECT_NONE);
    64      if (TOKEN (",")) {
    65        continue;
    66      } else if (TOKEN (")")) {
    67        go_on = FALSE;
    68      } else {
    69        EXPECT (2704, ", or )");
    70        go_on = FALSE;
    71      }
    72    }
    73    (void) rc;
    74  }


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