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 // 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 }
