genie-rows.c

     
   1  //! @file genie-rows.c
   2  //! @author J. Marcel van der Veer
   3  //!
   4  //! @section Copyright
   5  //!
   6  //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
   7  //! Copyright 2001-2023 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  //! Interpreter routines for ROW values.
  25  
  26  #include "a68g.h"
  27  #include "a68g-genie.h"
  28  #include "a68g-prelude.h"
  29  
  30  // Operators for ROW values.
  31  
  32  //! @brief OP ELEMS = (ROWS) INT
  33  
  34  void genie_monad_elems (NODE_T * p)
  35  {
  36    A68_REF z;
  37    A68_ARRAY *x;
  38    A68_TUPLE *t;
  39    POP_REF (p, &z);
  40  // Decrease pointer since a UNION is on the stack.
  41    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE);
  42    CHECK_REF (p, z, M_ROWS);
  43    GET_DESCRIPTOR (x, t, &z);
  44    PUSH_VALUE (p, get_row_size (t, DIM (x)), A68_INT);
  45  }
  46  
  47  //! @brief OP LWB = (ROWS) INT
  48  
  49  void genie_monad_lwb (NODE_T * p)
  50  {
  51    A68_REF z;
  52    A68_ARRAY *x;
  53    A68_TUPLE *t;
  54    POP_REF (p, &z);
  55  // Decrease pointer since a UNION is on the stack.
  56    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE);
  57    CHECK_REF (p, z, M_ROWS);
  58    GET_DESCRIPTOR (x, t, &z);
  59    PUSH_VALUE (p, LWB (t), A68_INT);
  60  }
  61  
  62  //! @brief OP UPB = (ROWS) INT
  63  
  64  void genie_monad_upb (NODE_T * p)
  65  {
  66    A68_REF z;
  67    A68_ARRAY *x;
  68    A68_TUPLE *t;
  69    POP_REF (p, &z);
  70  // Decrease pointer since a UNION is on the stack.
  71    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE);
  72    CHECK_REF (p, z, M_ROWS);
  73    GET_DESCRIPTOR (x, t, &z);
  74    PUSH_VALUE (p, UPB (t), A68_INT);
  75  }
  76  
  77  //! @brief OP ELEMS = (INT, ROWS) INT
  78  
  79  void genie_dyad_elems (NODE_T * p)
  80  {
  81    A68_REF z;
  82    A68_ARRAY *x;
  83    A68_TUPLE *t, *u;
  84    A68_INT k;
  85    POP_REF (p, &z);
  86  // Decrease pointer since a UNION is on the stack.
  87    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE);
  88    CHECK_REF (p, z, M_ROWS);
  89    POP_OBJECT (p, &k, A68_INT);
  90    GET_DESCRIPTOR (x, t, &z);
  91    if (VALUE (&k) < 1 || VALUE (&k) > DIM (x)) {
  92      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INVALID_DIMENSION, (int) VALUE (&k));
  93      exit_genie (p, A68_RUNTIME_ERROR);
  94    }
  95    u = &(t[VALUE (&k) - 1]);
  96    PUSH_VALUE (p, ROW_SIZE (u), A68_INT);
  97  }
  98  
  99  //! @brief OP LWB = (INT, ROWS) INT
 100  
 101  void genie_dyad_lwb (NODE_T * p)
 102  {
 103    A68_REF z;
 104    A68_ARRAY *x;
 105    A68_TUPLE *t;
 106    A68_INT k;
 107    POP_REF (p, &z);
 108  // Decrease pointer since a UNION is on the stack.
 109    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE);
 110    CHECK_REF (p, z, M_ROWS);
 111    POP_OBJECT (p, &k, A68_INT);
 112    GET_DESCRIPTOR (x, t, &z);
 113    if (VALUE (&k) < 1 || VALUE (&k) > DIM (x)) {
 114      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INVALID_DIMENSION, (int) VALUE (&k));
 115      exit_genie (p, A68_RUNTIME_ERROR);
 116    }
 117    PUSH_VALUE (p, LWB (&(t[VALUE (&k) - 1])), A68_INT);
 118  }
 119  
 120  //! @brief OP UPB = (INT, ROWS) INT
 121  
 122  void genie_dyad_upb (NODE_T * p)
 123  {
 124    A68_REF z;
 125    A68_ARRAY *x;
 126    A68_TUPLE *t;
 127    A68_INT k;
 128    POP_REF (p, &z);
 129  // Decrease pointer since a UNION is on the stack.
 130    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE);
 131    CHECK_REF (p, z, M_ROWS);
 132    POP_OBJECT (p, &k, A68_INT);
 133    GET_DESCRIPTOR (x, t, &z);
 134    if (VALUE (&k) < 1 || VALUE (&k) > DIM (x)) {
 135      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INVALID_DIMENSION, (int) VALUE (&k));
 136      exit_genie (p, A68_RUNTIME_ERROR);
 137    }
 138    PUSH_VALUE (p, UPB (&(t[VALUE (&k) - 1])), A68_INT);
 139  }