1 /****************************************************************************
2 **
3 ** This file is part of GAP, a system for computational discrete algebra.
4 **
5 ** Copyright of GAP belongs to its developers, whose names are too numerous
6 ** to list here. Please refer to the COPYRIGHT file for details.
7 **
8 ** SPDX-License-Identifier: GPL-2.0-or-later
9 **
10 ** This file stores code only required by the boehm garbage collector
11 **
12 ** The definitions of methods in this file can be found in gasman.h,
13 ** where the non-boehm versions of these methods live.
14 **/
15
16 #include "boehm_gc.h"
17
18 #include "gapstate.h"
19 #include "gasman.h"
20 #include "objects.h"
21 #include "sysmem.h"
22
23 #include "bags.inc"
24
25 #ifdef TRACK_CREATOR
26 #include "calls.h"
27 #include "vars.h"
28 #endif
29
30 #ifdef HPCGAP
31 #include "hpc/guards.h"
32 #include "hpc/misc.h"
33 #include "hpc/thread.h"
34 #endif
35
DATA(BagHeader * bag)36 static inline Bag * DATA(BagHeader * bag)
37 {
38 return (Bag *)(((char *)bag) + sizeof(BagHeader));
39 }
40
41
42 /****************************************************************************
43 **
44 *V DSInfoBags[<type>] . . . . . . . . . . . . . . region info for bags
45 */
46
47 #ifdef HPCGAP
48
49 static char DSInfoBags[NUM_TYPES];
50
51 #define DSI_TL 0
52 #define DSI_PUBLIC 1
53
MakeBagTypePublic(int type)54 void MakeBagTypePublic(int type)
55 {
56 DSInfoBags[type] = DSI_PUBLIC;
57 }
58
MakeBagPublic(Bag bag)59 Bag MakeBagPublic(Bag bag)
60 {
61 MEMBAR_WRITE();
62 SET_REGION(bag, 0);
63 return bag;
64 }
65
MakeBagReadOnly(Bag bag)66 Bag MakeBagReadOnly(Bag bag)
67 {
68 MEMBAR_WRITE();
69 SET_REGION(bag, ReadOnlyRegion);
70 return bag;
71 }
72
73 #endif // HPCGAP
74
75
76 /****************************************************************************
77 **
78 *F InitFreeFuncBag(<type>,<free-func>)
79 */
80
81 static TNumFreeFuncBags TabFreeFuncBags[NUM_TYPES];
82
InitFreeFuncBag(UInt type,TNumFreeFuncBags finalizer_func)83 void InitFreeFuncBag(UInt type, TNumFreeFuncBags finalizer_func)
84 {
85 TabFreeFuncBags[type] = finalizer_func;
86 }
87
88 #ifndef WARD_ENABLED
89
StandardFinalizer(void * bagContents,void * data)90 static void StandardFinalizer(void * bagContents, void * data)
91 {
92 Bag bag;
93 void * bagContents2;
94 bagContents2 = ((char *)bagContents) + sizeof(BagHeader);
95 bag = (Bag)&bagContents2;
96 TabFreeFuncBags[TNUM_BAG(bag)](bag);
97 }
98
99 #endif
100
101
102 static GC_descr GCDesc[MAX_GC_PREFIX_DESC + 1];
103 static unsigned GCKind[MAX_GC_PREFIX_DESC + 1];
104 static GC_descr GCMDesc[MAX_GC_PREFIX_DESC + 1];
105 static unsigned GCMKind[MAX_GC_PREFIX_DESC + 1];
106
107 /*
108 * Build memory layout information for Boehm GC.
109 *
110 * Bitmapped type descriptors have a bit set if the word at the
111 * corresponding offset may contain a reference. This is done
112 * by first creating a bitmap and then using GC_make_descriptor()
113 * to build a descriptor from the bitmap. Memory for a specific
114 * type layout can be allocated with GC_malloc_explicitly_typed()
115 * and GC_malloc_explicitly_typed_ignore_off_page().
116 *
117 * We also create a new 'kind' for each collector. Kinds have their
118 * own associated free lists and do not require to have type information
119 * stored in each bag, thus potentially saving some memory. Allocating
120 * memory of a specific kind is done with GC_generic_malloc(). There
121 * is no public _ignore_off_page() version for this call, so we use
122 * GC_malloc_explicitly_typed_ignore_off_page() instead, given that
123 * the overhead is negligible for large objects.
124 */
125
BuildPrefixGCDescriptor(unsigned prefix_len)126 static void BuildPrefixGCDescriptor(unsigned prefix_len)
127 {
128
129 if (prefix_len) {
130 GC_word bits[1] = { 0 };
131 unsigned i;
132 const UInt wordsInBagHeader = sizeof(BagHeader) / sizeof(Bag);
133 for (i = 0; i < prefix_len; i++)
134 GC_set_bit(bits, (i + wordsInBagHeader));
135 GCDesc[prefix_len] =
136 GC_make_descriptor(bits, prefix_len + wordsInBagHeader);
137 GC_set_bit(bits, 0);
138 GCMDesc[prefix_len] =
139 GC_make_descriptor(bits, prefix_len + wordsInBagHeader);
140 }
141 else {
142 GCDesc[prefix_len] = GC_DS_LENGTH;
143 GCMDesc[prefix_len] = GC_DS_LENGTH | sizeof(void *);
144 }
145 GCKind[prefix_len] =
146 GC_new_kind(GC_new_free_list(), GCDesc[prefix_len], 0, 1);
147 GCMKind[prefix_len] =
148 GC_new_kind(GC_new_free_list(), GCMDesc[prefix_len], 0, 0);
149 }
150
151
152 static void TLAllocatorInit(void);
153
154
155 #define GRANULE_SIZE (2 * sizeof(UInt))
156
157 static unsigned char TLAllocatorSeg[TL_GC_SIZE / GRANULE_SIZE + 1];
158 static unsigned TLAllocatorSize[TL_GC_SIZE / GRANULE_SIZE];
159 static UInt TLAllocatorMaxSeg;
160
TLAllocatorInit(void)161 static void TLAllocatorInit(void)
162 {
163 unsigned stage = 16;
164 unsigned inc = 1;
165 unsigned i = 0;
166 unsigned k = 0;
167 unsigned j;
168 unsigned max = TL_GC_SIZE / GRANULE_SIZE;
169 while (i <= max) {
170 if (i == stage) {
171 stage *= 2;
172 inc *= 2;
173 }
174 TLAllocatorSize[k] = i * GRANULE_SIZE;
175 TLAllocatorSeg[i] = k;
176 for (j = 1; j < inc; j++) {
177 if (i + j <= max)
178 TLAllocatorSeg[i + j] = k + 1;
179 }
180 i += inc;
181 k++;
182 }
183 TLAllocatorMaxSeg = k;
184 if (MAX_GC_PREFIX_DESC * sizeof(void *) > sizeof(STATE(FreeList)))
185 abort();
186 }
187
188 /****************************************************************************
189 **
190 *F AllocateBagMemory( <gc_type>, <type>, <size> )
191 **
192 ** Allocate memory for a new bag.
193 **
194 ** 'AllocateBagMemory' is an auxiliary routine for the Boehm GC that
195 ** allocates memory from the appropriate pool. 'gc_type' is -1 if all words
196 ** in the bag can refer to other bags, 0 if the bag will not contain any
197 ** references to other bags, and > 0 to indicate a specific memory layout
198 ** descriptor.
199 **/
AllocateBagMemory(int gc_type,int type,UInt size)200 static void * AllocateBagMemory(int gc_type, int type, UInt size)
201 {
202 assert(gc_type >= -1);
203 void * result = NULL;
204 if (size <= TL_GC_SIZE) {
205 UInt alloc_seg, alloc_size;
206 alloc_size = (size + GRANULE_SIZE - 1) / GRANULE_SIZE;
207 alloc_seg = TLAllocatorSeg[alloc_size];
208 alloc_size = TLAllocatorSize[alloc_seg];
209 void *** freeList = STATE(FreeList);
210 if (!freeList[gc_type + 1]) {
211 freeList[gc_type + 1] =
212 GC_malloc(sizeof(void *) * TLAllocatorMaxSeg);
213 }
214 void ** freeListForType = freeList[gc_type + 1];
215 result = freeListForType[alloc_seg];
216 if (!result) {
217 if (gc_type < 0)
218 freeListForType[alloc_seg] = GC_malloc_many(alloc_size);
219 else
220 GC_generic_malloc_many(alloc_size, GCMKind[gc_type],
221 &freeListForType[alloc_seg]);
222 result = freeListForType[alloc_seg];
223 }
224 freeListForType[alloc_seg] = *(void **)result;
225 memset(result, 0, alloc_size);
226 }
227 else {
228 if (gc_type >= 0)
229 result = GC_generic_malloc(size, GCKind[gc_type]);
230 else
231 result = GC_malloc(size);
232 }
233 if (TabFreeFuncBags[type])
234 GC_register_finalizer_no_order(result, StandardFinalizer, NULL, NULL,
235 NULL);
236 return result;
237 }
238
AllocateMemoryBlock(UInt size)239 void * AllocateMemoryBlock(UInt size)
240 {
241 return GC_malloc(size);
242 }
243
244 static int TabMarkTypeBags[NUM_TYPES];
245
InitMarkFuncBags(UInt type,TNumMarkFuncBags mark_func)246 void InitMarkFuncBags(UInt type, TNumMarkFuncBags mark_func)
247 {
248 int mark_type;
249 if (mark_func == MarkNoSubBags)
250 mark_type = 0;
251 else if (mark_func == MarkAllSubBags)
252 mark_type = -1;
253 else if (mark_func == MarkOneSubBags)
254 mark_type = 1;
255 else if (mark_func == MarkTwoSubBags)
256 mark_type = 2;
257 else if (mark_func == MarkThreeSubBags)
258 mark_type = 3;
259 else if (mark_func == MarkFourSubBags)
260 mark_type = 4;
261 else
262 mark_type = -1;
263 TabMarkTypeBags[type] = mark_type;
264 }
265
SetExtraMarkFuncBags(TNumExtraMarkFuncBags func)266 void SetExtraMarkFuncBags(TNumExtraMarkFuncBags func)
267 {
268 Panic("SetExtraMarkFuncBags not implemented for Boehm GC");
269 }
270
InitBags(UInt initial_size,Bag * stack_bottom,UInt stack_align)271 void InitBags(UInt initial_size,
272 Bag * stack_bottom,
273 UInt stack_align)
274 {
275 UInt i; /* loop variable */
276
277 /* install the marking functions */
278 for (i = 0; i < NUM_TYPES; i++) {
279 TabMarkTypeBags[i] = -1;
280 }
281 #ifndef DISABLE_GC
282 #ifdef HPCGAP
283 if (!getenv("GC_MARKERS")) {
284 /* The Boehm GC does not have an API to set the number of
285 * markers for the parallel mark and sweep implementation,
286 * so we use the documented environment variable GC_MARKERS
287 * instead. However, we do not override it if it's already
288 * set.
289 */
290 static char marker_env_str[32];
291 unsigned num_markers = 2;
292 if (!SyNumGCThreads)
293 SyNumGCThreads = SyNumProcessors;
294 if (SyNumGCThreads) {
295 if (SyNumGCThreads <= MAX_GC_THREADS)
296 num_markers = (unsigned)SyNumProcessors;
297 else
298 num_markers = MAX_GC_THREADS;
299 }
300 sprintf(marker_env_str, "GC_MARKERS=%u", num_markers);
301 putenv(marker_env_str);
302 }
303 #endif
304 GC_set_all_interior_pointers(0);
305 GC_set_handle_fork(1);
306 GC_init();
307 GC_set_free_space_divisor(1);
308 TLAllocatorInit();
309 GC_register_displacement(0);
310 GC_register_displacement(sizeof(BagHeader));
311 initial_size *= 1024;
312 if (GC_get_heap_size() < initial_size)
313 GC_expand_hp(initial_size - GC_get_heap_size());
314 if (SyStorKill)
315 GC_set_max_heap_size(SyStorKill * 1024);
316 #ifdef HPCGAP
317 AddGCRoots();
318 CreateMainRegion();
319 #else
320 void * p = ActiveGAPState();
321 GC_add_roots(p, (char *)p + sizeof(GAPState));
322 #endif
323 for (i = 0; i <= MAX_GC_PREFIX_DESC; i++) {
324 BuildPrefixGCDescriptor(i);
325 /* This is necessary to initialize some internal structures
326 * in the garbage collector: */
327 GC_generic_malloc(sizeof(BagHeader) + i * sizeof(Bag), GCMKind[i]);
328 }
329 #endif /* DISABLE_GC */
330 }
331
CollectBags(UInt size,UInt full)332 UInt CollectBags(UInt size, UInt full)
333 {
334 #ifndef DISABLE_GC
335 GC_gcollect();
336 #endif
337 return 1;
338 }
339
340 #ifdef HPCGAP
RetypeBagIfWritable(Obj obj,UInt new_type)341 void RetypeBagIfWritable(Obj obj, UInt new_type)
342 {
343 if (CheckWriteAccess(obj))
344 RetypeBag(obj, new_type);
345 }
346 #endif
347
RetypeBag(Bag bag,UInt new_type)348 void RetypeBag(Bag bag, UInt new_type)
349 {
350 BagHeader * header = BAG_HEADER(bag);
351 UInt old_type = header->type;
352
353 /* change the size-type word */
354 header->type = new_type;
355 {
356 int old_gctype, new_gctype;
357 UInt size;
358 void *new_mem, *old_mem;
359 old_gctype = TabMarkTypeBags[old_type];
360 new_gctype = TabMarkTypeBags[new_type];
361 if (old_gctype != new_gctype) {
362 size = SIZE_BAG(bag) + sizeof(BagHeader);
363 new_mem = AllocateBagMemory(new_gctype, new_type, size);
364 old_mem = PTR_BAG(bag);
365 old_mem = ((char *)old_mem) - sizeof(BagHeader);
366 memcpy(new_mem, old_mem, size);
367 SET_PTR_BAG(bag, (void *)(((char *)new_mem) + sizeof(BagHeader)));
368 }
369 }
370 #ifdef HPCGAP
371 switch (DSInfoBags[new_type]) {
372 case DSI_PUBLIC:
373 SET_REGION(bag, NULL);
374 break;
375 }
376 #endif // HPCGAP
377 }
378
NewBag(UInt type,UInt size)379 Bag NewBag(UInt type, UInt size)
380 {
381 Bag bag; /* identifier of the new bag */
382 UInt alloc_size;
383
384 alloc_size = sizeof(BagHeader) + size;
385 #ifndef DISABLE_GC
386 #ifndef TRACK_CREATOR
387 bag = GC_malloc(2 * sizeof(Bag *));
388 #else
389 bag = GC_malloc(4 * sizeof(Bag *));
390 if (STATE(PtrLVars)) {
391 bag[2] = (void *)CURR_FUNC();
392 if (STATE(CurrLVars) != STATE(BottomLVars)) {
393 Obj plvars = PARENT_LVARS(STATE(CurrLVars));
394 bag[3] = (void *)(FUNC_LVARS(plvars));
395 }
396 }
397 #endif
398
399 SizeAllBags += size;
400
401 /* If the size of an object is zero (such as an empty permutation),
402 * and the header size is a multiple of twice the word size of the
403 * architecture, then the master pointer will actually point past
404 * the allocated area. Because this would result in the object
405 * being freed prematurely, we will allocate at least one extra
406 * byte so that the master pointer actually points to within an
407 * allocated memory area.
408 */
409 if (size == 0)
410 alloc_size++;
411 /* While we use the Boehm GC without the "all interior pointers"
412 * option, stack references to the interior of an object will
413 * still be valid from any reference on the stack. This can lead,
414 * for example, to a 1GB string never being freed if there's an
415 * integer on the stack that happens to also be a reference to
416 * any character inside that string. The garbage collector does
417 * this because after compiler optimizations (especially reduction
418 * in strength) references to the beginning of an object may be
419 * lost.
420 *
421 * However, this is not generally a risk with GAP objects, because
422 * master pointers on the heap will always retain a reference to
423 * the start of the object (or, more precisely, to the first byte
424 * past the header area). Hence, compiler optimizations pose no
425 * actual risk unless the master pointer is destroyed also.
426 *
427 * To avoid the scenario where large objects do not get deallocated,
428 * we therefore use the _ignore_off_page() calls. One caveat here
429 * is that these calls do not use thread-local allocation, making
430 * them somewhat slower. Hence, we only use them for sufficiently
431 * large objects.
432 */
433 BagHeader * header =
434 AllocateBagMemory(TabMarkTypeBags[type], type, alloc_size);
435 #else
436 bag = malloc(2 * sizeof(Bag *));
437 BagHeader * header = calloc(1, alloc_size);
438 #endif /* DISABLE_GC */
439
440 header->type = type;
441 header->flags = 0;
442 header->size = size;
443
444 /* set the masterpointer */
445 SET_PTR_BAG(bag, DATA(header));
446 #ifdef HPCGAP
447 switch (DSInfoBags[type]) {
448 case DSI_TL:
449 SET_REGION(bag, CurrentRegion());
450 break;
451 case DSI_PUBLIC:
452 SET_REGION(bag, NULL);
453 break;
454 }
455 #endif
456
457 /* return the identifier of the new bag */
458 return bag;
459 }
460
ResizeBag(Bag bag,UInt new_size)461 UInt ResizeBag(Bag bag, UInt new_size)
462 {
463 UInt type; /* type of the bag */
464 UInt flags;
465 UInt old_size; /* old size of the bag */
466 Bag * src; /* source in copying */
467 UInt alloc_size;
468
469 /* check the size */
470
471 #ifdef TREMBLE_HEAP
472 CollectBags(0, 0);
473 #endif
474
475 BagHeader * header = BAG_HEADER(bag);
476
477 /* get type and old size of the bag */
478 type = header->type;
479 flags = header->flags;
480 old_size = header->size;
481
482 #ifdef COUNT_BAGS
483 /* update the statistics */
484 InfoBags[type].sizeLive += new_size - old_size;
485 InfoBags[type].sizeAll += new_size - old_size;
486 #endif
487 SizeAllBags += new_size - old_size;
488
489 #ifndef DISABLE_GC
490 alloc_size = GC_size(header);
491 /* An alternative implementation would be to compare
492 * new_size <= alloc_size in the following test in order
493 * to avoid reallocations for alternating contractions
494 * and expansions. However, typed allocation in the Boehm
495 * GC stores layout information in the last word of a memory
496 * block and we may accidentally overwrite this information,
497 * because GC_size() includes that extraneous word when
498 * returning the size of a memory block.
499 *
500 * This is technically a bug in GC_size(), but until and
501 * unless there is an upstream fix, we'll do it the safe
502 * way.
503 */
504 if (new_size <= old_size &&
505 sizeof(BagHeader) + new_size >= alloc_size * 3 / 4) {
506 #else
507 if (new_size <= old_size) {
508 #endif /* DISABLE_GC */
509
510 /* change the size word */
511 header->size = new_size;
512 }
513
514 /* if the bag is enlarged */
515 else {
516 alloc_size = sizeof(BagHeader) + new_size;
517 if (new_size == 0)
518 alloc_size++;
519 #ifndef DISABLE_GC
520 header = AllocateBagMemory(TabMarkTypeBags[type], type, alloc_size);
521 #else
522 header = calloc(1, alloc_size);
523 #endif
524
525 header->type = type;
526 header->flags = flags;
527 header->size = new_size;
528
529 // copy data and update the masterpointer
530 src = PTR_BAG(bag);
531 memcpy(DATA(header), src, old_size < new_size ? old_size : new_size);
532 SET_PTR_BAG(bag, DATA(header));
533 }
534 /* return success */
535 return 1;
536 }
537
538
539 /*****************************************************************************
540 ** The following functions are not required respectively supported, so empty
541 ** implementations are provided
542 **
543 */
544
545 void InitGlobalBag(Bag * addr, const Char * cookie)
546 {
547 }
548
549 void SwapMasterPoint(Bag bag1, Bag bag2)
550 {
551 Obj * ptr1 = PTR_BAG(bag1);
552 Obj * ptr2 = PTR_BAG(bag2);
553 SET_PTR_BAG(bag1, ptr2);
554 SET_PTR_BAG(bag2, ptr1);
555 }
556