genie-assign.c
1 //! @file genie-assign.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 assignations.
25
26 #include "a68g.h"
27 #include "a68g-genie.h"
28 #include "a68g-frames.h"
29 #include "a68g-prelude.h"
30
31 //! @brief Assign a value to a name and voiden.
32
33 PROP_T genie_voiding_assignation_constant (NODE_T * p)
34 {
35 NODE_T *dst = SUB (p);
36 NODE_T *src = SOURCE (&PROP (GINFO (NEXT_NEXT (dst))));
37 ADDR_T pop_sp = A68_SP;
38 A68_REF *z = (A68_REF *) STACK_TOP;
39 PROP_T self;
40 UNIT (&self) = genie_voiding_assignation_constant;
41 SOURCE (&self) = p;
42 GENIE_UNIT (dst);
43 CHECK_REF (p, *z, MOID (p));
44 COPY (ADDRESS (z), CONSTANT (GINFO (src)), SIZE (GINFO (src)));
45 A68_SP = pop_sp;
46 return self;
47 }
48
49 //! @brief Assign a value to a name and voiden.
50
51 PROP_T genie_voiding_assignation (NODE_T * p)
52 {
53 NODE_T *dst = SUB (p);
54 NODE_T *src = NEXT_NEXT (dst);
55 MOID_T *src_mode = SUB_MOID (dst);
56 ADDR_T pop_sp = A68_SP, pop_fp = FRAME_DNS (A68_FP);
57 A68_REF z;
58 PROP_T self;
59 UNIT (&self) = genie_voiding_assignation;
60 SOURCE (&self) = p;
61 GENIE_UNIT (dst);
62 POP_OBJECT (p, &z, A68_REF);
63 CHECK_REF (p, z, MOID (p));
64 FRAME_DNS (A68_FP) = REF_SCOPE (&z);
65 GENIE_UNIT (src);
66 STACK_DNS (src, src_mode, REF_SCOPE (&z));
67 FRAME_DNS (A68_FP) = pop_fp;
68 A68_SP = pop_sp;
69 if (HAS_ROWS (src_mode)) {
70 genie_clone_stack (p, src_mode, &z, &z);
71 } else {
72 COPY_ALIGNED (ADDRESS (&z), STACK_TOP, SIZE (src_mode));
73 }
74 return self;
75 }
76
77 //! @brief Assign a value to a name and push the name.
78
79 PROP_T genie_assignation_constant (NODE_T * p)
80 {
81 NODE_T *dst = SUB (p);
82 NODE_T *src = SOURCE (&PROP (GINFO (NEXT_NEXT (dst))));
83 A68_REF *z = (A68_REF *) STACK_TOP;
84 PROP_T self;
85 UNIT (&self) = genie_assignation_constant;
86 SOURCE (&self) = p;
87 GENIE_UNIT (dst);
88 CHECK_REF (p, *z, MOID (p));
89 COPY (ADDRESS (z), CONSTANT (GINFO (src)), SIZE (GINFO (src)));
90 return self;
91 }
92
93 //! @brief Assign a value to a name and push the name.
94
95 PROP_T genie_assignation_quick (NODE_T * p)
96 {
97 NODE_T *dst = SUB (p);
98 NODE_T *src = NEXT_NEXT (dst);
99 MOID_T *src_mode = SUB_MOID (dst);
100 int size = SIZE (src_mode);
101 ADDR_T pop_fp = FRAME_DNS (A68_FP);
102 A68_REF *z = (A68_REF *) STACK_TOP;
103 GENIE_UNIT (dst);
104 CHECK_REF (p, *z, MOID (p));
105 FRAME_DNS (A68_FP) = REF_SCOPE (z);
106 GENIE_UNIT (src);
107 STACK_DNS (src, src_mode, REF_SCOPE (z));
108 FRAME_DNS (A68_FP) = pop_fp;
109 DECREMENT_STACK_POINTER (p, size);
110 if (HAS_ROWS (src_mode)) {
111 genie_clone_stack (p, src_mode, z, z);
112 } else {
113 COPY (ADDRESS (z), STACK_TOP, size);
114 }
115 PROP_T self;
116 UNIT (&self) = genie_assignation_quick;
117 SOURCE (&self) = p;
118 return self;
119 }
120
121 //! @brief Assign a value to a name and push the name.
122
123 PROP_T genie_assignation (NODE_T * p)
124 {
125 PROP_T self, srp;
126 NODE_T *dst = SUB (p);
127 NODE_T *src = NEXT_NEXT (dst);
128 MOID_T *src_mode = SUB_MOID (dst);
129 int size = SIZE (src_mode);
130 ADDR_T pop_fp = FRAME_DNS (A68_FP);
131 A68_REF *z = (A68_REF *) STACK_TOP;
132 GENIE_UNIT (dst);
133 CHECK_REF (p, *z, MOID (p));
134 FRAME_DNS (A68_FP) = REF_SCOPE (z);
135 GENIE_UNIT_2 (src, srp);
136 STACK_DNS (src, src_mode, REF_SCOPE (z));
137 FRAME_DNS (A68_FP) = pop_fp;
138 DECREMENT_STACK_POINTER (p, size);
139 if (HAS_ROWS (src_mode)) {
140 genie_clone_stack (p, src_mode, z, z);
141 UNIT (&self) = genie_assignation;
142 } else {
143 COPY (ADDRESS (z), STACK_TOP, size);
144 if (UNIT (&srp) == genie_constant) {
145 UNIT (&self) = genie_assignation_constant;
146 } else {
147 UNIT (&self) = genie_assignation_quick;
148 }
149 }
150 SOURCE (&self) = p;
151 return self;
152 }
