a68g-mem.c
1 //! @file a68g-mem.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-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 //! Low-level memory management.
25
26 #include "a68g.h"
27 #include "a68g-prelude.h"
28 #include "a68g-mp.h"
29 #include "a68g-genie.h"
30
31 //! @brief Initialise C and A68 heap management.
32
33 void init_heap (void)
34 {
35 unt heap_a_size = A68_ALIGN (A68 (heap_size));
36 unt handle_a_size = A68_ALIGN (A68 (handle_pool_size));
37 unt frame_a_size = A68_ALIGN (A68 (frame_stack_size));
38 unt expr_a_size = A68_ALIGN (A68 (expr_stack_size));
39 BYTE_T *core;
40 A68_HEAP = NO_BYTE;
41 A68_HANDLES = NO_BYTE;
42 A68_STACK = NO_BYTE;
43 A68_SP = 0;
44 A68_FP = 0;
45 A68_HP = 0;
46 A68_GLOBALS = 0;
47 REAL_T /* sic */ total_size = A68_ALIGN (heap_a_size + handle_a_size + frame_a_size + 2 * expr_a_size);
48 ABEND (OVER_2G (total_size), ERROR_OUT_OF_CORE_2G, __func__);
49 errno = 0;
50 core = (BYTE_T *) (A68_ALIGN_T *) a68_alloc ((size_t) total_size, __func__, __LINE__);
51 ABEND (core == NO_BYTE, ERROR_OUT_OF_CORE, __func__);
52 A68_HEAP = &(core[0]);
53 A68_HANDLES = &(A68_HEAP[heap_a_size]);
54 A68_STACK = &(A68_HANDLES[handle_a_size]);
55 A68 (fixed_heap_pointer) = A68_ALIGNMENT;
56 A68 (temp_heap_pointer) = total_size;
57 A68 (frame_start) = 0;
58 A68 (frame_end) = A68 (stack_start) = A68 (frame_start) + frame_a_size;
59 A68 (stack_end) = A68 (stack_start) + expr_a_size;
60 ABEND (errno != 0, ERROR_ALLOCATION, __func__);
61 }
62
63 //! @brief aligned allocation.
64
65 void *a68_alloc (size_t len, const char *f, int line)
66 {
67 // We need this since malloc aligns to "standard C types".
68 // __float128 is not a standard type, apparently ...
69 // Huge chunks cause trouble!
70 ABEND (len >= 2 * GIGABYTE, ERROR_OUT_OF_CORE, __func__);
71 if (len > 0) {
72 void *p = NULL;
73 int save = errno;
74 size_t align = sizeof (A68_ALIGN_T);
75 errno = 0;
76 #if defined (BUILD_WIN32)
77 p = _aligned_malloc (len, align);
78 #elif defined (HAVE_POSIX_MEMALIGN)
79 errno = posix_memalign (&p, align, len);
80 if (errno != 0) {
81 p = NULL;
82 }
83 #elif defined (HAVE_ALIGNED_ALLOC)
84 // Glibc version of posix_memalign.
85 if (align < sizeof (void *)) {
86 errno = EINVAL;
87 } else {
88 p = aligned_alloc (align, len);
89 }
90 #else
91 // Aude audenda.
92 p = malloc (len);
93 #endif
94 if (p == (void *) NULL || errno != 0) {
95 static BUFFER msg;
96 snprintf (msg, SNPRINTF_SIZE, "cannot allocate %lu bytes; called from function %s, line %d", (long unt) len, f, line);
97 ABEND (A68_TRUE, ERROR_ALLOCATION, msg);
98 }
99 errno = save;
100 return p;
101 } else {
102 return (void *) NULL;
103 }
104 }
105
106 void a68_free (void *z)
107 {
108 if (z != NULL) {
109 #if defined (BUILD_WIN32)
110 // On WIN32, free cannot deallocate _aligned_malloc
111 _aligned_free (z);
112 #else
113 free (z);
114 #endif
115 }
116 }
117
118 //! @brief Give pointer to block of "s" bytes.
119
120 BYTE_T *get_heap_space (size_t s)
121 {
122 BYTE_T *z;
123 ABEND (s == 0, ERROR_INVALID_SIZE, __func__);
124 z = (BYTE_T *) (A68_ALIGN_T *) a68_alloc (A68_ALIGN (s), __func__, __LINE__);
125 ABEND (z == NO_BYTE, ERROR_OUT_OF_CORE, __func__);
126 return z;
127 }
128
129 //! @brief Make a new copy of concatenated strings.
130
131 char *new_string (char *t, ...)
132 {
133 va_list vl;
134 char *q, *z;
135 int len = 0;
136 va_start (vl, t);
137 q = t;
138 if (q == NO_TEXT) {
139 va_end (vl);
140 return NO_TEXT;
141 }
142 while (q != NO_TEXT) {
143 len += (int) strlen (q);
144 q = va_arg (vl, char *);
145 }
146 va_end (vl);
147 len++;
148 z = (char *) get_heap_space ((size_t) len);
149 z[0] = NULL_CHAR;
150 q = t;
151 va_start (vl, t);
152 while (q != NO_TEXT) {
153 bufcat (z, q, len);
154 q = va_arg (vl, char *);
155 }
156 va_end (vl);
157 return z;
158 }
159
160 //! @brief Make a new copy of "t".
161
162 char *new_fixed_string (char *t)
163 {
164 int n = (int) (strlen (t) + 1);
165 char *z = (char *) get_fixed_heap_space ((size_t) n);
166 bufcpy (z, t, n);
167 return z;
168 }
169
170 //! @brief Make a new copy of "t".
171
172 char *new_temp_string (char *t)
173 {
174 int n = (int) (strlen (t) + 1);
175 char *z = (char *) get_temp_heap_space ((size_t) n);
176 bufcpy (z, t, n);
177 return z;
178 }
179
180 //! @brief Get (preferably fixed) heap space.
181
182 BYTE_T *get_fixed_heap_space (size_t s)
183 {
184 BYTE_T *z;
185 if (A68 (heap_is_fluid)) {
186 z = HEAP_ADDRESS (A68 (fixed_heap_pointer));
187 A68 (fixed_heap_pointer) += A68_ALIGN ((int) s);
188 // Allow for extra storage for diagnostics etcetera
189 ABEND (A68 (fixed_heap_pointer) >= (A68 (heap_size) - MIN_MEM_SIZE), ERROR_OUT_OF_CORE, __func__);
190 ABEND (((unt) A68 (temp_heap_pointer) - (unt) A68 (fixed_heap_pointer)) <= MIN_MEM_SIZE, ERROR_OUT_OF_CORE, __func__);
191 return z;
192 } else {
193 return get_heap_space (s);
194 }
195 }
196
197 //! @brief Get (preferably temporary) heap space.
198
199 BYTE_T *get_temp_heap_space (size_t s)
200 {
201 BYTE_T *z;
202 if (A68 (heap_is_fluid)) {
203 A68 (temp_heap_pointer) -= A68_ALIGN ((int) s);
204 // Allow for extra storage for diagnostics etcetera.
205 ABEND (((unt) A68 (temp_heap_pointer) - (unt) A68 (fixed_heap_pointer)) <= MIN_MEM_SIZE, ERROR_OUT_OF_CORE, __func__);
206 z = HEAP_ADDRESS (A68 (temp_heap_pointer));
207 return z;
208 } else {
209 return get_heap_space (s);
210 }
211 }
212
213 //! @brief Get size of stack segment.
214
215 void get_stack_size (void)
216 {
217 #if defined (BUILD_WIN32)
218 A68 (stack_size) = MEGABYTE; // Guestimate
219 #else
220 struct rlimit limits;
221 errno = 0;
222 // Some systems do not implement RLIMIT_STACK so if getrlimit fails, we do not abend.
223 if (!(getrlimit (RLIMIT_STACK, &limits) == 0 && errno == 0)) {
224 A68 (stack_size) = MEGABYTE;
225 }
226 A68 (stack_size) = (unt) (RLIM_CUR (&limits) < RLIM_MAX (&limits) ? RLIM_CUR (&limits) : RLIM_MAX (&limits));
227 // A heuristic in case getrlimit yields extreme numbers: the frame stack is
228 // assumed to fill at a rate comparable to the C stack, so the C stack needs
229 // not be larger than the frame stack. This may not be true.
230 if (A68 (stack_size) < KILOBYTE || (A68 (stack_size) > 96 * MEGABYTE && A68 (stack_size) > A68 (frame_stack_size))) {
231 A68 (stack_size) = A68 (frame_stack_size);
232 }
233 #endif
234 A68 (stack_limit) = (A68 (stack_size) > (4 * A68 (storage_overhead)) ? (A68 (stack_size) - A68 (storage_overhead)) : A68 (stack_size) / 2);
235 }
236
237 //! @brief Free heap allocated by genie.
238
239 void genie_free (NODE_T * p)
240 {
241 for (; p != NO_NODE; FORWARD (p)) {
242 genie_free (SUB (p));
243 if (GINFO (p) != NO_GINFO) {
244 a68_free (CONSTANT (GINFO (p)));
245 CONSTANT (GINFO (p)) = NO_CONSTANT;
246 a68_free (COMPILE_NAME (GINFO (p)));
247 COMPILE_NAME (GINFO (p)) = NO_TEXT;
248 }
249 }
250 }
251
252 //! @brief Free heap allocated by genie.
253
254 void free_syntax_tree (NODE_T * p)
255 {
256 for (; p != NO_NODE; FORWARD (p)) {
257 free_syntax_tree (SUB (p));
258 a68_free (NPRAGMENT (p));
259 NPRAGMENT (p) = NO_TEXT;
260 DIAGNOSTIC_T *d = DIAGNOSTICS (LINE (INFO (p)));
261 while (d != NO_DIAGNOSTIC) {
262 a68_free (TEXT (d));
263 DIAGNOSTIC_T *stale = d;
264 FORWARD (d);
265 a68_free (stale);
266 }
267 DIAGNOSTICS (LINE (INFO (p))) = NO_DIAGNOSTIC;
268 }
269 }
