external.c

     1  //! @file external.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 declarations.
    25  
    26  #include <vif.h>
    27  
    28  void externals (void)
    29  {
    30    int_4 rc, set = 0;
    31    while ((rc = scan (EXPECT_NONE)) != END_OF_LINE) {
    32      if (TOKEN (",")) {
    33        ;
    34      } else if (rc == WORD || rc == DECLAR) {
    35        set++;
    36        if (/* rc == WORD && reserved (curlex) */ FALSE) {
    37          ERROR (1601, "reserved symbol", curlex);
    38        }
    39        MODE mode;
    40        extf_decl (curlex, &mode);
    41      } else {
    42        EXPECT (1602, "subprogram name");
    43      }
    44    }
    45    if (set == 0) {
    46      SYNTAX (1603, "external statement");
    47    }
    48  }
    49  
    50  void intrinsics (void)
    51  {
    52    int_4 rc, set = 0;
    53    while ((rc = scan (EXPECT_NONE)) != END_OF_LINE) {
    54      INTRINS *fun;
    55      if (TOKEN (",")) {
    56        ;
    57      } else if (!is_intrins (curlex, &fun)){
    58        EXPECT (1604, "intrinsic funcion name");
    59      } else {
    60        set++;
    61        if (/* rc == WORD && reserved (curlex) */ FALSE) {
    62          ERROR (1605, "reserved symbol", curlex);
    63        }
    64        NEW_RECORD (name);
    65        bufcpy (name, curlex, RECLN);
    66        compile_nested_intrinsic (name);
    67      }
    68    }
    69    if (set == 0) {
    70      SYNTAX (1606, "intrinsic statement");
    71    }
    72  }


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