a68g-frames.h
1 //! @file a68g-frames.h
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-2025 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 //! Macros for opening/closing frames.
25
26 #if !defined (__A68G_FRAMES_H__)
27 #define __A68G_FRAMES_H__
28
29 // Operations on stack frames
30
31 #define FRAME_ADDRESS(n) ((BYTE_T *) &(A68G_STACK[n]))
32 #define FACT(n) ((ACTIVATION_RECORD *) FRAME_ADDRESS (n))
33 #define FRAME_CLEAR(m) FILL ((BYTE_T *) FRAME_OFFSET (FRAME_INFO_SIZE), 0, (m))
34 #define FRAME_BLOCKS(n) (BLOCKS (FACT (n)))
35 #define FRAME_DYNAMIC_LINK(n) (DYNAMIC_LINK (FACT (n)))
36 #define FRAME_DNS(n) (DYNAMIC_SCOPE (FACT (n)))
37 #define FRAME_INCREMENT(n) (AP_INCREMENT (TABLE (FRAME_TREE(n))))
38 #define FRAME_INFO_SIZE (A68G_FRAME_ALIGN (sizeof (ACTIVATION_RECORD)))
39 #define FRAME_JUMP_STAT(n) (JUMP_STAT (FACT (n)))
40 #define FRAME_LEXICAL_LEVEL(n) (FRAME_LEVEL (FACT (n)))
41 #define FRAME_LOCAL(n, m) (FRAME_ADDRESS ((n) + FRAME_INFO_SIZE + (m)))
42 #define FRAME_NUMBER(n) (FRAME_NO (FACT (n)))
43 #define FRAME_OBJECT(n) (FRAME_OFFSET (FRAME_INFO_SIZE + (n)))
44 #define FRAME_OFFSET(n) (FRAME_ADDRESS (A68G_FP + (n)))
45 #define FRAME_PARAMETER_LEVEL(n) (PARAMETER_LEVEL (FACT (n)))
46 #define FRAME_PARAMETERS(n) (PARAMETERS (FACT (n)))
47 #define FRAME_PROC_FRAME(n) (PROC_FRAME (FACT (n)))
48 #define FRAME_SIZE(fp) (FRAME_INFO_SIZE + FRAME_INCREMENT (fp))
49 #define FRAME_STATIC_LINK(n) (STATIC_LINK (FACT (n)))
50 #define FRAME_TREE(n) (NODE (FACT (n)))
51
52 #if defined (BUILD_PARALLEL_CLAUSE)
53 #define FRAME_THREAD_ID(n) (THREAD_ID (FACT (n)))
54 #endif
55
56 #define FOLLOW_SL(dest, l) {\
57 (dest) = A68G_FP;\
58 if ((l) <= FRAME_PARAMETER_LEVEL ((dest))) {\
59 (dest) = FRAME_PARAMETERS ((dest));\
60 }\
61 while ((l) != FRAME_LEXICAL_LEVEL ((dest))) {\
62 (dest) = FRAME_STATIC_LINK ((dest));\
63 }}
64
65 #define FOLLOW_STATIC_LINK(dest, l) {\
66 if ((l) == A68G (global_level) && A68G_GLOBALS > 0) {\
67 (dest) = A68G_GLOBALS;\
68 } else {\
69 FOLLOW_SL (dest, l)\
70 }}
71
72 #define FRAME_GET(dest, cast, p) {\
73 ADDR_T _m_z;\
74 FOLLOW_STATIC_LINK (_m_z, LEVEL (GINFO (p)));\
75 (dest) = (cast *) & (OFFSET (GINFO (p))[_m_z]);\
76 }
77
78 #define GET_FRAME(dest, cast, level, offset) {\
79 ADDR_T _m_z;\
80 FOLLOW_SL (_m_z, (level));\
81 (dest) = (cast *) & (A68G_STACK [_m_z + FRAME_INFO_SIZE + (offset)]);\
82 }
83
84 #define GET_GLOBAL(dest, cast, offset) {\
85 (dest) = (cast *) & (A68G_STACK [A68G_GLOBALS + FRAME_INFO_SIZE + (offset)]);\
86 }
87
88 // Opening of stack frames is in-line
89
90 //
91 // STATIC_LINK_FOR_FRAME: determine static link for stack frame.
92 // new_lex_lvl: lexical level of new stack frame.
93 // returns: static link for stack frame at 'new_lex_lvl'.
94
95 #define STATIC_LINK_FOR_FRAME(dest, new_lex_lvl) {\
96 int _m_cur_lex_lvl = FRAME_LEXICAL_LEVEL (A68G_FP);\
97 if (_m_cur_lex_lvl == (new_lex_lvl)) {\
98 (dest) = FRAME_STATIC_LINK (A68G_FP);\
99 } else if (_m_cur_lex_lvl > (new_lex_lvl)) {\
100 ADDR_T _m_static_link = A68G_FP;\
101 while (FRAME_LEXICAL_LEVEL (_m_static_link) >= (new_lex_lvl)) {\
102 _m_static_link = FRAME_STATIC_LINK (_m_static_link);\
103 }\
104 (dest) = _m_static_link;\
105 } else {\
106 (dest) = A68G_FP;\
107 }}
108
109 #define INIT_STATIC_FRAME(p) {\
110 FRAME_CLEAR (AP_INCREMENT (TABLE (p)));\
111 if (INITIALISE_FRAME (TABLE (p))) {\
112 initialise_frame (p);\
113 }}
114
115 #define INIT_GLOBAL_POINTER(p) {\
116 if (LEX_LEVEL (p) == A68G (global_level)) {\
117 A68G_GLOBALS = A68G_FP;\
118 }}
119
120 #define INCREMENT_FP(n) {\
121 A68G_FP += (n);\
122 ABEND (A68G_FP >= A68G (stack_start), ERROR_STACK_OVERFLOW, __func__);\
123 }
124
125 #if defined (BUILD_PARALLEL_CLAUSE)
126 #define OPEN_STATIC_FRAME(p) {\
127 ADDR_T dynamic_link = A68G_FP, static_link;\
128 STATIC_LINK_FOR_FRAME (static_link, LEX_LEVEL (p));\
129 ACTIVATION_RECORD *pre = FACT (A68G_FP);\
130 INCREMENT_FP (FRAME_SIZE (dynamic_link));\
131 ACTIVATION_RECORD *act = FACT (A68G_FP);\
132 FRAME_NO (act) = FRAME_NO (pre) + 1;\
133 FRAME_LEVEL (act) = LEX_LEVEL (p);\
134 PARAMETER_LEVEL (act) = PARAMETER_LEVEL (pre);\
135 PARAMETERS (act) = PARAMETERS (pre);\
136 STATIC_LINK (act) = static_link;\
137 DYNAMIC_LINK (act) = dynamic_link;\
138 DYNAMIC_SCOPE (act) = A68G_FP;\
139 NODE (act) = p;\
140 JUMP_STAT (act) = NO_JMP_BUF;\
141 PROC_FRAME (act) = A68G_FALSE;\
142 THREAD_ID (act) = pthread_self ();\
143 }
144 #else
145 #define OPEN_STATIC_FRAME(p) {\
146 ADDR_T dynamic_link = A68G_FP, static_link;\
147 STATIC_LINK_FOR_FRAME (static_link, LEX_LEVEL (p));\
148 ACTIVATION_RECORD *pre = FACT (A68G_FP);\
149 INCREMENT_FP (FRAME_SIZE (dynamic_link));\
150 ACTIVATION_RECORD *act = FACT (A68G_FP);\
151 FRAME_NO (act) = FRAME_NO (pre) + 1;\
152 FRAME_LEVEL (act) = LEX_LEVEL (p);\
153 PARAMETER_LEVEL (act) = PARAMETER_LEVEL (pre);\
154 PARAMETERS (act) = PARAMETERS (pre);\
155 STATIC_LINK (act) = static_link;\
156 DYNAMIC_LINK (act) = dynamic_link;\
157 DYNAMIC_SCOPE (act) = A68G_FP;\
158 NODE (act) = p;\
159 JUMP_STAT (act) = NO_JMP_BUF;\
160 PROC_FRAME (act) = A68G_FALSE;\
161 }
162 #endif
163
164 //! @def OPEN_PROC_FRAME
165 //! @brief Open a stack frame for a procedure.
166
167 #if defined (BUILD_PARALLEL_CLAUSE)
168 #define OPEN_PROC_FRAME(p, environ) {\
169 LOW_STACK_ALERT (p);\
170 ADDR_T dynamic_link = A68G_FP, static_link = (environ > 0 ? environ : A68G_FP);\
171 if (A68G_FP < static_link) {\
172 diagnostic (A68G_RUNTIME_ERROR, (p), ERROR_SCOPE_DYNAMIC_0);\
173 exit_genie (p, A68G_RUNTIME_ERROR);\
174 }\
175 INCREMENT_FP (FRAME_SIZE (dynamic_link));\
176 ACTIVATION_RECORD *act = FACT (A68G_FP);\
177 FRAME_NO (act) = FRAME_NUMBER (dynamic_link) + 1;\
178 FRAME_LEVEL (act) = LEX_LEVEL (p);\
179 PARAMETER_LEVEL (act) = LEX_LEVEL (p);\
180 PARAMETERS (act) = A68G_FP;\
181 STATIC_LINK (act) = static_link;\
182 DYNAMIC_LINK (act) = dynamic_link;\
183 DYNAMIC_SCOPE (act) = A68G_FP;\
184 NODE (act) = p;\
185 JUMP_STAT (act) = NO_JMP_BUF;\
186 PROC_FRAME (act) = A68G_TRUE;\
187 THREAD_ID (act) = pthread_self ();\
188 }
189 #else
190 #define OPEN_PROC_FRAME(p, environ) {\
191 LOW_STACK_ALERT (p);\
192 ADDR_T dynamic_link = A68G_FP, static_link = (environ > 0 ? environ : A68G_FP);\
193 if (A68G_FP < static_link) {\
194 diagnostic (A68G_RUNTIME_ERROR, (p), ERROR_SCOPE_DYNAMIC_0);\
195 exit_genie (p, A68G_RUNTIME_ERROR);\
196 }\
197 INCREMENT_FP (FRAME_SIZE (dynamic_link));\
198 ACTIVATION_RECORD *act = FACT (A68G_FP);\
199 FRAME_NO (act) = FRAME_NUMBER (dynamic_link) + 1;\
200 FRAME_LEVEL (act) = LEX_LEVEL (p);\
201 PARAMETER_LEVEL (act) = LEX_LEVEL (p);\
202 PARAMETERS (act) = A68G_FP;\
203 STATIC_LINK (act) = static_link;\
204 DYNAMIC_LINK (act) = dynamic_link;\
205 DYNAMIC_SCOPE (act) = A68G_FP;\
206 NODE (act) = p;\
207 JUMP_STAT (act) = NO_JMP_BUF;\
208 PROC_FRAME (act) = A68G_TRUE;\
209 }
210 #endif
211
212 #define CLOSE_FRAME {\
213 ACTIVATION_RECORD *act = FACT (A68G_FP);\
214 A68G_FP = DYNAMIC_LINK (act);\
215 }
216
217 #endif
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|