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