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-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 //! 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 *) &(A68_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 (A68_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 (A68_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) = A68_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) == A68 (global_level) && A68_GLOBALS > 0) {\
67 (dest) = A68_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 *) & (A68_STACK [_m_z + FRAME_INFO_SIZE + (offset)]);\
82 }
83
84 #define GET_GLOBAL(dest, cast, offset) {\
85 (dest) = (cast *) & (A68_STACK [A68_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 (A68_FP);\
97 if (_m_cur_lex_lvl == (new_lex_lvl)) {\
98 (dest) = FRAME_STATIC_LINK (A68_FP);\
99 } else if (_m_cur_lex_lvl > (new_lex_lvl)) {\
100 ADDR_T _m_static_link = A68_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) = A68_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) == A68 (global_level)) {\
117 A68_GLOBALS = A68_FP;\
118 }}
119
120 #if defined (BUILD_PARALLEL_CLAUSE)
121 #define OPEN_STATIC_FRAME(p) {\
122 ADDR_T dynamic_link = A68_FP, static_link;\
123 STATIC_LINK_FOR_FRAME (static_link, LEX_LEVEL (p));\
124 ACTIVATION_RECORD *pre = FACT (A68_FP);\
125 A68_FP += FRAME_SIZE (dynamic_link);\
126 ACTIVATION_RECORD *act = FACT (A68_FP);\
127 FRAME_NO (act) = FRAME_NO (pre) + 1;\
128 FRAME_LEVEL (act) = LEX_LEVEL (p);\
129 PARAMETER_LEVEL (act) = PARAMETER_LEVEL (pre);\
130 PARAMETERS (act) = PARAMETERS (pre);\
131 STATIC_LINK (act) = static_link;\
132 DYNAMIC_LINK (act) = dynamic_link;\
133 DYNAMIC_SCOPE (act) = A68_FP;\
134 NODE (act) = p;\
135 JUMP_STAT (act) = NO_JMP_BUF;\
136 PROC_FRAME (act) = A68_FALSE;\
137 THREAD_ID (act) = pthread_self ();\
138 }
139 #else
140 #define OPEN_STATIC_FRAME(p) {\
141 ADDR_T dynamic_link = A68_FP, static_link;\
142 STATIC_LINK_FOR_FRAME (static_link, LEX_LEVEL (p));\
143 ACTIVATION_RECORD *pre = FACT (A68_FP);\
144 A68_FP += FRAME_SIZE (dynamic_link);\
145 ACTIVATION_RECORD *act = FACT (A68_FP);\
146 FRAME_NO (act) = FRAME_NO (pre) + 1;\
147 FRAME_LEVEL (act) = LEX_LEVEL (p);\
148 PARAMETER_LEVEL (act) = PARAMETER_LEVEL (pre);\
149 PARAMETERS (act) = PARAMETERS (pre);\
150 STATIC_LINK (act) = static_link;\
151 DYNAMIC_LINK (act) = dynamic_link;\
152 DYNAMIC_SCOPE (act) = A68_FP;\
153 NODE (act) = p;\
154 JUMP_STAT (act) = NO_JMP_BUF;\
155 PROC_FRAME (act) = A68_FALSE;\
156 }
157 #endif
158
159 //! @def OPEN_PROC_FRAME
160 //! @brief Open a stack frame for a procedure.
161
162 #if defined (BUILD_PARALLEL_CLAUSE)
163 #define OPEN_PROC_FRAME(p, environ) {\
164 LOW_STACK_ALERT (p);\
165 ADDR_T dynamic_link = A68_FP, static_link = (environ > 0 ? environ : A68_FP);\
166 if (A68_FP < static_link) {\
167 diagnostic (A68_RUNTIME_ERROR, (p), ERROR_SCOPE_DYNAMIC_0);\
168 exit_genie (p, A68_RUNTIME_ERROR);\
169 }\
170 A68_FP += FRAME_SIZE (dynamic_link);\
171 ACTIVATION_RECORD *act = FACT (A68_FP);\
172 FRAME_NO (act) = FRAME_NUMBER (dynamic_link) + 1;\
173 FRAME_LEVEL (act) = LEX_LEVEL (p);\
174 PARAMETER_LEVEL (act) = LEX_LEVEL (p);\
175 PARAMETERS (act) = A68_FP;\
176 STATIC_LINK (act) = static_link;\
177 DYNAMIC_LINK (act) = dynamic_link;\
178 DYNAMIC_SCOPE (act) = A68_FP;\
179 NODE (act) = p;\
180 JUMP_STAT (act) = NO_JMP_BUF;\
181 PROC_FRAME (act) = A68_TRUE;\
182 THREAD_ID (act) = pthread_self ();\
183 }
184 #else
185 #define OPEN_PROC_FRAME(p, environ) {\
186 LOW_STACK_ALERT (p);\
187 ADDR_T dynamic_link = A68_FP, static_link = (environ > 0 ? environ : A68_FP);\
188 if (A68_FP < static_link) {\
189 diagnostic (A68_RUNTIME_ERROR, (p), ERROR_SCOPE_DYNAMIC_0);\
190 exit_genie (p, A68_RUNTIME_ERROR);\
191 }\
192 A68_FP += FRAME_SIZE (dynamic_link);\
193 ACTIVATION_RECORD *act = FACT (A68_FP);\
194 FRAME_NO (act) = FRAME_NUMBER (dynamic_link) + 1;\
195 FRAME_LEVEL (act) = LEX_LEVEL (p);\
196 PARAMETER_LEVEL (act) = LEX_LEVEL (p);\
197 PARAMETERS (act) = A68_FP;\
198 STATIC_LINK (act) = static_link;\
199 DYNAMIC_LINK (act) = dynamic_link;\
200 DYNAMIC_SCOPE (act) = A68_FP;\
201 NODE (act) = p;\
202 JUMP_STAT (act) = NO_JMP_BUF;\
203 PROC_FRAME (act) = A68_TRUE;\
204 }
205 #endif
206
207 #define CLOSE_FRAME {\
208 ACTIVATION_RECORD *act = FACT (A68_FP);\
209 A68_FP = DYNAMIC_LINK (act);\
210 }
211
212 #endif
