Algol 68 Genie

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-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  //! Interpreter routines for ROW values.
  25  
  26  // An A68G row is a reference to a descriptor in the heap:
  27  //
  28  // A68_REF row -> A68_ARRAY ----+   ARRAY: Description of row, ref to elements.
  29  //                A68_TUPLE 1   |   TUPLE: Bounds, one for every dimension.
  30  //                ...           |
  31  //                A68_TUPLE dim |
  32  //                ...           |
  33  //                ...           |
  34  //                Element 1 <---+   Sequential row elements in the heap.
  35  //                ...
  36  //                Element n
  37  
  38  #include "a68g.h"
  39  #include "a68g-genie.h"
  40  #include "a68g-prelude.h"
  41  
  42  // Operators for ROW values.
  43  
  44  //! @brief OP ELEMS = (ROWS) INT
  45  
  46  void genie_monad_elems (NODE_T * p)
  47  {
  48    A68_REF row;
  49    POP_REF (p, &row);
  50    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE); // Pop UNION.
  51    CHECK_REF (p, row, M_ROWS);
  52    A68_ARRAY *arr; A68_TUPLE *tup;
  53    GET_DESCRIPTOR (arr, tup, &row);
  54    PUSH_VALUE (p, get_row_size (tup, DIM (arr)), A68_INT);
  55  }
  56  
  57  //! @brief OP LWB = (ROWS) INT
  58  
  59  void genie_monad_lwb (NODE_T * p)
  60  {
  61    A68_REF row;
  62    POP_REF (p, &row);
  63    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE); // Pop UNION.
  64    CHECK_REF (p, row, M_ROWS);
  65    A68_ARRAY *arr; A68_TUPLE *tup;
  66    GET_DESCRIPTOR (arr, tup, &row);
  67    PUSH_VALUE (p, LWB (tup), A68_INT);
  68  }
  69  
  70  //! @brief OP UPB = (ROWS) INT
  71  
  72  void genie_monad_upb (NODE_T * p)
  73  {
  74    A68_REF row;
  75    POP_REF (p, &row);
  76    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE); // Pop UNION.
  77    CHECK_REF (p, row, M_ROWS);
  78    A68_ARRAY *arr; A68_TUPLE *tup;
  79    GET_DESCRIPTOR (arr, tup, &row);
  80    PUSH_VALUE (p, UPB (tup), A68_INT);
  81  }
  82  
  83  //! @brief OP ELEMS = (INT, ROWS) INT
  84  
  85  void genie_dyad_elems (NODE_T * p)
  86  {
  87    A68_REF row;
  88    POP_REF (p, &row);
  89    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE); // Pop UNION.
  90    CHECK_REF (p, row, M_ROWS);
  91    A68_INT k;
  92    POP_OBJECT (p, &k, A68_INT);
  93    A68_ARRAY *arr; A68_TUPLE *tup;
  94    GET_DESCRIPTOR (arr, tup, &row);
  95    if (VALUE (&k) < 1 || VALUE (&k) > DIM (arr)) {
  96      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INVALID_DIMENSION, (int) VALUE (&k));
  97      exit_genie (p, A68_RUNTIME_ERROR);
  98    }
  99    A68_TUPLE *u = &(tup[VALUE (&k) - 1]);
 100    PUSH_VALUE (p, ROW_SIZE (u), A68_INT);
 101  }
 102  
 103  //! @brief OP LWB = (INT, ROWS) INT
 104  
 105  void genie_dyad_lwb (NODE_T * p)
 106  {
 107    A68_REF row;
 108    POP_REF (p, &row);
 109    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE); // Pop UNION.
 110    CHECK_REF (p, row, M_ROWS);
 111    A68_INT k;
 112    POP_OBJECT (p, &k, A68_INT);
 113    A68_ARRAY *arr; A68_TUPLE *tup;
 114    GET_DESCRIPTOR (arr, tup, &row);
 115    if (VALUE (&k) < 1 || VALUE (&k) > DIM (arr)) {
 116      diagnostic (A68_RUNTIME_ERROR, p, ERROR_INVALID_DIMENSION, (int) VALUE (&k));
 117      exit_genie (p, A68_RUNTIME_ERROR);
 118    }
 119    PUSH_VALUE (p, LWB (&(tup[VALUE (&k) - 1])), A68_INT);
 120  }
 121  
 122  //! @brief OP UPB = (INT, ROWS) INT
 123  
 124  void genie_dyad_upb (NODE_T * p)
 125  {
 126    A68_REF row;
 127    POP_REF (p, &row);
 128    DECREMENT_STACK_POINTER (p, A68_UNION_SIZE); // Pop UNION.
 129    CHECK_REF (p, row, M_ROWS);
 130    A68_INT k;
 131    POP_OBJECT (p, &k, A68_INT);
 132    A68_ARRAY *arr; A68_TUPLE *tup;
 133    GET_DESCRIPTOR (arr, tup, &row);
 134    if (VALUE (&k) < 1 || VALUE (&k) > DIM (arr)) {
 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 (&(tup[VALUE (&k) - 1])), A68_INT);
 139  }
Deze website is gearchiveerd door de KB, nationale bibliotheek.

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