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-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 PARAMETER statement.
  25  
  26  #include <vif.h>
  27  
  28  void parameter (void)
  29  {
  30    int_4 rc, go_on = TRUE;
  31    rc = scan (NULL);
  32    if (!TOKEN ("(")) {
  33      EXPECT (2301, "(");
  34      return;
  35    }
  36    while (go_on) {
  37      rc = scan (NULL);
  38      if (TOKEN (")")) {
  39        break;
  40      }
  41      if (rc != WORD) {
  42        EXPECT (2302, "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 (NULL);
  49      EXPR reg;
  50      express (&reg, mode.type, mode.len);
  51      if (reg.variant == EXPR_CONST) {
  52        idf->parm = stralloc (reg.str);
  53        if (idf->mode.type == NOTYPE) {
  54          idf->mode = reg.mode;
  55        }
  56        // Write constant in the listing file.
  57        RECORD fold;
  58        RECCLR (fold);
  59        snprintf (fold, RECLN, "// %s = %s", CID(idf), idf->parm);
  60        code (nprocs, PARAMETERS, fold); 
  61      } else {
  62        EXPECT (2303, "constant");
  63      }
  64      rc = scan (NULL);
  65      if (TOKEN (",")) {
  66        continue;
  67      } else if (TOKEN (")")) {
  68        go_on = FALSE;
  69      } else {
  70        EXPECT (2304, ", or )");
  71        go_on = FALSE;
  72      }
  73    }
  74    (void) rc;
  75  }
     


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