genie-formula.c
1 //! @file genie-formula.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 formulas.
25
26 #include "a68g.h"
27 #include "a68g-genie.h"
28 #include "a68g-frames.h"
29 #include "a68g-prelude.h"
30
31 //! @brief Push equality of two REFs.
32
33 PROP_T genie_identity_relation (NODE_T * p)
34 {
35 NODE_T *lhs = SUB (p), *rhs = NEXT_NEXT (lhs);
36 A68_REF x, y;
37 GENIE_UNIT (lhs);
38 POP_REF (p, &y);
39 GENIE_UNIT (rhs);
40 POP_REF (p, &x);
41 if (IS (NEXT_SUB (p), IS_SYMBOL)) {
42 PUSH_VALUE (p, (BOOL_T) (ADDRESS (&x) == ADDRESS (&y)), A68_BOOL);
43 } else {
44 PUSH_VALUE (p, (BOOL_T) (ADDRESS (&x) != ADDRESS (&y)), A68_BOOL);
45 }
46 PROP_T self;
47 UNIT (&self) = genie_identity_relation;
48 SOURCE (&self) = p;
49 return self;
50 }
51
52 //! @brief Push result of ANDF or THEF.
53
54 PROP_T genie_and_function (NODE_T * p)
55 {
56 A68_BOOL x;
57 GENIE_UNIT (SUB (p));
58 POP_OBJECT (p, &x, A68_BOOL);
59 if (VALUE (&x) == A68_TRUE) {
60 GENIE_UNIT (NEXT_NEXT (SUB (p)));
61 } else {
62 PUSH_VALUE (p, A68_FALSE, A68_BOOL);
63 }
64 PROP_T self;
65 UNIT (&self) = genie_and_function;
66 SOURCE (&self) = p;
67 return self;
68 }
69
70 //! @brief Push result of ORF or ELSF.
71
72 PROP_T genie_or_function (NODE_T * p)
73 {
74 A68_BOOL x;
75 GENIE_UNIT (SUB (p));
76 POP_OBJECT (p, &x, A68_BOOL);
77 if (VALUE (&x) == A68_FALSE) {
78 GENIE_UNIT (NEXT_NEXT (SUB (p)));
79 } else {
80 PUSH_VALUE (p, A68_TRUE, A68_BOOL);
81 }
82 PROP_T self;
83 UNIT (&self) = genie_or_function;
84 SOURCE (&self) = p;
85 return self;
86 }
87
88 //! @brief Call operator.
89
90 void genie_call_operator (NODE_T * p, ADDR_T pop_sp)
91 {
92 ADDR_T pop_fp = A68_FP;
93 MOID_T *pr_mode = MOID (TAX (p));
94 A68_PROCEDURE *z;
95 FRAME_GET (z, A68_PROCEDURE, p);
96 genie_call_procedure (p, pr_mode, MOID (z), pr_mode, z, pop_sp, pop_fp);
97 STACK_DNS (p, SUB (pr_mode), A68_FP);
98 }
99
100 //! @brief Push result of monadic formula OP "u".
101
102 PROP_T genie_monadic (NODE_T * p)
103 {
104 NODE_T *op = SUB (p);
105 NODE_T *u = NEXT (op);
106 ADDR_T pop_sp = A68_SP;
107 GENIE_UNIT (u);
108 STACK_DNS (u, MOID (u), A68_FP);
109 if (PROCEDURE (TAX (op)) != NO_GPROC) {
110 (void) ((*(PROCEDURE (TAX (op)))) (op));
111 } else {
112 genie_call_operator (op, pop_sp);
113 }
114 PROP_T self;
115 UNIT (&self) = genie_monadic;
116 SOURCE (&self) = p;
117 return self;
118 }
119
120 //! @brief Push result of formula.
121
122 PROP_T genie_dyadic_quick (NODE_T * p)
123 {
124 NODE_T *u = SUB (p);
125 NODE_T *op = NEXT (u);
126 NODE_T *v = NEXT (op);
127 GENIE_UNIT (u);
128 STACK_DNS (u, MOID (u), A68_FP);
129 GENIE_UNIT (v);
130 STACK_DNS (v, MOID (v), A68_FP);
131 (void) ((*(PROCEDURE (TAX (op)))) (op));
132 return GPROP (p);
133 }
134
135 //! @brief Push result of formula.
136
137 PROP_T genie_dyadic (NODE_T * p)
138 {
139 NODE_T *u = SUB (p);
140 NODE_T *op = NEXT (u);
141 NODE_T *v = NEXT (op);
142 ADDR_T pop_sp = A68_SP;
143 GENIE_UNIT (u);
144 STACK_DNS (u, MOID (u), A68_FP);
145 GENIE_UNIT (v);
146 STACK_DNS (v, MOID (v), A68_FP);
147 if (PROCEDURE (TAX (op)) != NO_GPROC) {
148 (void) ((*(PROCEDURE (TAX (op)))) (op));
149 } else {
150 genie_call_operator (op, pop_sp);
151 }
152 return GPROP (p);
153 }
154
155 //! @brief Push result of formula.
156
157 PROP_T genie_formula (NODE_T * p)
158 {
159 NODE_T *u = SUB (p);
160 NODE_T *op = NEXT (u);
161 ADDR_T pop_sp = A68_SP;
162 PROP_T self, lhs, rhs;
163 UNIT (&self) = genie_formula;
164 SOURCE (&self) = p;
165 GENIE_UNIT_2 (u, lhs);
166 STACK_DNS (u, MOID (u), A68_FP);
167 if (op != NO_NODE) {
168 NODE_T *v = NEXT (op);
169 GPROC *proc = PROCEDURE (TAX (op));
170 GENIE_UNIT_2 (v, rhs);
171 STACK_DNS (v, MOID (v), A68_FP);
172 UNIT (&self) = genie_dyadic;
173 if (proc != NO_GPROC) {
174 (void) ((*(proc)) (op));
175 UNIT (&self) = genie_dyadic_quick;
176 } else {
177 genie_call_operator (op, pop_sp);
178 }
179 return self;
180 } else if (UNIT (&lhs) == genie_monadic) {
181 return lhs;
182 }
183 (void) rhs;
184 return self;
185 }
