Algol 68 Genie

assign.c

     1  //! @file assign.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 assignments.
    25  
    26  #include <vif.h>
    27  
    28  void assign (EXPR * reg)
    29  {
    30  #define ASSIGN_ERROR(s) {\
    31      NEW_RECORD (str);\
    32      _srecordf (str, "%s = %s", qtype (&(lhs.mode)), qtype (&(rhs.mode)));\
    33      ERROR (101, (s), str);\
    34      return;\
    35    }
    36    int_4 rc;
    37    EXPR lhs, rhs;
    38    memset (&lhs, 0, sizeof (lhs));
    39    memset (&rhs, 0, sizeof (rhs));
    40    lhs_factor = TRUE;
    41    factor (&lhs);
    42    lhs_factor = FALSE;
    43    if (lhs.variant != EXPR_VAR && lhs.variant != EXPR_SLICE && lhs.variant != EXPR_SUBSTR) {
    44      ERROR (102, "invalid lhs in assignment", lhs.str);
    45      skip_card (FALSE);
    46      return;
    47    }
    48    if (lhs.variant == EXPR_VAR) {
    49      IDENT *idf = impl_decl (lhs.str, NO_MODE);
    50      if (idf != NO_IDENT && IS_ROW (idf->mode)) {
    51        ERROR (103, "cannot assign to dimensioned variable", curlex);
    52        skip_card (FALSE);
    53        return;
    54      }
    55    }
    56    rc = scan (EXPECT_NONE);
    57    if (TOKEN ("=")) {
    58      rc = scan (EXPECT_NONE);
    59      exprio (&rhs, 1, TRUE);
    60      (void) fold_expr (&rhs, rhs.mode.type);
    61      rc = scan (EXPECT_NONE);
    62    } else {
    63      EXPECT (104, "=");
    64    }
    65  // Assign.
    66    if (lhs.mode.type == CHARACTER && rhs.mode.type == CHARACTER) {
    67      // character*n = character*m; m <= n
    68      if (lhs.variant == EXPR_SUBSTR) {
    69        _srecordf (reg->str, "bufrep (%s, %s)", lhs.str, rhs.str);
    70      } else if (lhs.mode.len == 0) {
    71        _srecordf (reg->str, "strcpy (%s, %s)", lhs.str, rhs.str);
    72      } else {
    73        _srecordf (reg->str, "bufcpy (%s, %s, %d)", lhs.str, rhs.str, lhs.mode.len);
    74      }
    75    } else if (rhs.variant == EXPR_CONST && rhs.mode.type == INTEGER && lhs.mode.type == INTEGER) {
    76  // INTEGER length denotations overlap.
    77      factor_integer_number (&rhs, rhs.str);
    78      if (rhs.mode.len > lhs.mode.len) {
    79        MODE_ERROR (105, qtype (&(rhs.mode)), qtype (&(lhs.mode)));
    80      } 
    81      _srecordf (reg->str, "%s = %s", lhs.str, rhs.str);
    82    } else if (lhs.mode.type == rhs.mode.type && lhs.mode.len == rhs.mode.len) {
    83      if (strcmp (lhs.str, rhs.str) == 0) {
    84        _srecordf (reg->str, "/* %s = %s */", lhs.str, rhs.str);
    85      } else {
    86        _srecordf (reg->str, "%s = %s", lhs.str, rhs.str);
    87      }
    88    } else {
    89      EXPR new = (EXPR) {.mode = lhs.mode};
    90      if (!coerce (&new, &rhs)) {
    91        MODE_ERROR (106, qtype (&(rhs.mode)), qtype (&(lhs.mode)));
    92      }  
    93      _srecordf (reg->str, "%s = %s", lhs.str, new.str);
    94    }
    95    skip_card (TRUE);
    96    (void) rc;
    97  }
Deze website is gearchiveerd door de KB, nationale bibliotheek.

This website is archived by the National Library of the Netherlands.