genie-declaration.c
1 //! @file genie-declaration.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 declarations.
25
26 #include "a68g.h"
27 #include "a68g-genie.h"
28 #include "a68g-frames.h"
29 #include "a68g-prelude.h"
30
31 //! @brief Execute identity declaration.
32
33 void genie_identity_dec (NODE_T * p)
34 {
35 for (; p != NO_NODE; FORWARD (p)) {
36 if (ISNT (p, DEFINING_IDENTIFIER)) {
37 genie_identity_dec (SUB (p));
38 } else {
39 A68_REF loc;
40 NODE_T *src = NEXT_NEXT (p);
41 MOID_T *src_mode = MOID (p);
42 unt size = (unt) SIZE (src_mode);
43 BYTE_T *tos = STACK_TOP;
44 ADDR_T pop_sp = A68_SP;
45 ADDR_T pop_dns = FRAME_DNS (A68_FP);
46 FRAME_DNS (A68_FP) = A68_FP;
47 GENIE_UNIT_TRACE (src);
48 genie_check_initialisation (src, tos, src_mode);
49 STACK_DNS (src, src_mode, A68_FP);
50 FRAME_DNS (A68_FP) = pop_dns;
51 // Make a temporary REF to the object in the frame.
52 STATUS (&loc) = (STATUS_MASK_T) (INIT_MASK | IN_FRAME_MASK);
53 REF_HANDLE (&loc) = (A68_HANDLE *) & nil_handle;
54 OFFSET (&loc) = A68_FP + FRAME_INFO_SIZE + OFFSET (TAX (p));
55 REF_SCOPE (&loc) = A68_FP;
56 ABEND (ADDRESS (&loc) != FRAME_OBJECT (OFFSET (TAX (p))), ERROR_INTERNAL_CONSISTENCY, __func__);
57 // Initialise the tag, value is in the stack.
58 if (HAS_ROWS (src_mode)) {
59 A68_SP = pop_sp;
60 genie_clone_stack (p, src_mode, &loc, (A68_REF *) & nil_ref);
61 } else if (UNIT (&GPROP (src)) == genie_constant) {
62 STATUS_SET (TAX (p), CONSTANT_MASK);
63 POP_ALIGNED (p, ADDRESS (&loc), size);
64 } else {
65 POP_ALIGNED (p, ADDRESS (&loc), size);
66 }
67 return;
68 }
69 }
70 }
71
72 //! @brief Execute variable declaration.
73
74 void genie_variable_dec (NODE_T * p, NODE_T ** declarer, ADDR_T sp)
75 {
76 for (; p != NO_NODE; FORWARD (p)) {
77 if (IS (p, VARIABLE_DECLARATION)) {
78 genie_variable_dec (SUB (p), declarer, sp);
79 } else {
80 if (IS (p, DECLARER)) {
81 (*declarer) = SUB (p);
82 genie_generator_bounds (*declarer);
83 FORWARD (p);
84 }
85 if (IS (p, DEFINING_IDENTIFIER)) {
86 MOID_T *ref_mode = MOID (p);
87 TAG_T *tag = TAX (p);
88 LEAP_T leap = (HEAP (tag) == LOC_SYMBOL ? LOC_SYMBOL : HEAP_SYMBOL);
89 A68_REF *z;
90 MOID_T *src_mode = SUB_MOID (p);
91 z = (A68_REF *) (FRAME_OBJECT (OFFSET (TAX (p))));
92 genie_generator_internal (*declarer, ref_mode, BODY (tag), leap, sp);
93 POP_REF (p, z);
94 if (NEXT (p) != NO_NODE && IS (NEXT (p), ASSIGN_SYMBOL)) {
95 NODE_T *src = NEXT_NEXT (p);
96 ADDR_T pop_sp = A68_SP;
97 ADDR_T pop_dns = FRAME_DNS (A68_FP);
98 FRAME_DNS (A68_FP) = A68_FP;
99 GENIE_UNIT_TRACE (src);
100 STACK_DNS (src, src_mode, A68_FP);
101 FRAME_DNS (A68_FP) = pop_dns;
102 A68_SP = pop_sp;
103 if (HAS_ROWS (src_mode)) {
104 genie_clone_stack (p, src_mode, z, z);
105 } else {
106 MOVE (ADDRESS (z), STACK_TOP, (unt) SIZE (src_mode));
107 }
108 }
109 }
110 }
111 }
112 }
113
114 //! @brief Execute PROC variable declaration.
115
116 void genie_proc_variable_dec (NODE_T * p)
117 {
118 for (; p != NO_NODE; FORWARD (p)) {
119 switch (ATTRIBUTE (p)) {
120 case DEFINING_IDENTIFIER: {
121 ADDR_T sp_for_voiding = A68_SP;
122 MOID_T *ref_mode = MOID (p);
123 TAG_T *tag = TAX (p);
124 LEAP_T leap = (HEAP (tag) == LOC_SYMBOL ? LOC_SYMBOL : HEAP_SYMBOL);
125 A68_REF *z = (A68_REF *) (FRAME_OBJECT (OFFSET (TAX (p))));
126 genie_generator_internal (p, ref_mode, BODY (tag), leap, A68_SP);
127 POP_REF (p, z);
128 if (NEXT (p) != NO_NODE && IS (NEXT (p), ASSIGN_SYMBOL)) {
129 MOID_T *src_mode = SUB_MOID (p);
130 ADDR_T pop_sp = A68_SP;
131 ADDR_T pop_dns = FRAME_DNS (A68_FP);
132 FRAME_DNS (A68_FP) = A68_FP;
133 GENIE_UNIT_TRACE (NEXT_NEXT (p));
134 STACK_DNS (p, SUB (ref_mode), A68_FP);
135 FRAME_DNS (A68_FP) = pop_dns;
136 A68_SP = pop_sp;
137 MOVE (ADDRESS (z), STACK_TOP, (unt) SIZE (src_mode));
138 }
139 A68_SP = sp_for_voiding; // Voiding
140 return;
141 }
142 default: {
143 genie_proc_variable_dec (SUB (p));
144 break;
145 }
146 }
147 }
148 }
149
150 //! @brief Execute operator declaration.
151
152 void genie_operator_dec (NODE_T * p)
153 {
154 for (; p != NO_NODE; FORWARD (p)) {
155 switch (ATTRIBUTE (p)) {
156 case DEFINING_OPERATOR: {
157 A68_PROCEDURE *z = (A68_PROCEDURE *) (FRAME_OBJECT (OFFSET (TAX (p))));
158 ADDR_T pop_dns = FRAME_DNS (A68_FP);
159 FRAME_DNS (A68_FP) = A68_FP;
160 GENIE_UNIT_TRACE (NEXT_NEXT (p));
161 STACK_DNS (p, MOID (p), A68_FP);
162 FRAME_DNS (A68_FP) = pop_dns;
163 POP_PROCEDURE (p, z);
164 return;
165 }
166 default: {
167 genie_operator_dec (SUB (p));
168 break;
169 }
170 }
171 }
172 }
173
174 //! @brief Execute declaration.
175
176 void genie_declaration (NODE_T * p)
177 {
178 for (; p != NO_NODE; FORWARD (p)) {
179 switch (ATTRIBUTE (p)) {
180 case MODE_DECLARATION:
181 case PROCEDURE_DECLARATION:
182 case BRIEF_OPERATOR_DECLARATION:
183 case PRIORITY_DECLARATION: {
184 // Already resolved.
185 return;
186 }
187 case IDENTITY_DECLARATION: {
188 genie_identity_dec (SUB (p));
189 break;
190 }
191 case OPERATOR_DECLARATION: {
192 genie_operator_dec (SUB (p));
193 break;
194 }
195 case VARIABLE_DECLARATION: {
196 NODE_T *declarer = NO_NODE;
197 ADDR_T pop_sp = A68_SP;
198 genie_variable_dec (SUB (p), &declarer, A68_SP);
199 // Voiding to remove garbage from declarers.
200 A68_SP = pop_sp;
201 break;
202 }
203 case PROCEDURE_VARIABLE_DECLARATION: {
204 ADDR_T pop_sp = A68_SP;
205 genie_proc_variable_dec (SUB (p));
206 A68_SP = pop_sp;
207 break;
208 }
209 default: {
210 genie_declaration (SUB (p));
211 break;
212 }
213 }
214 }
215 }
