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 }
