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 contains the functions of Gasman, the GAP storage manager.
11 **
12 ** {\Gasman} is a storage manager for applications written in C. That means
13 ** that an application using {\Gasman} requests blocks of storage from
14 ** {\Gasman}. Those blocks of storage are called *bags*. Then the
15 ** application writes data into and reads data from the bags. Finally a bag
16 ** is no longer needed and the application simply forgets it. We say that
17 ** such a bag that is no longer needed is *dead*. {\Gasman} cares about the
18 ** allocation of bags and deallocation of dead bags. Thus these operations
19 ** are transparent to the application, enabling the programmer to
20 ** concentrate on algorithms instead of caring about storage allocation and
21 ** deallocation.
22 **
23 ** {\Gasman} implements an automatic, cooperating, compacting, generational,
24 ** conservative storage management
25 **
26 ** *Automatic* means that the application only allocates bags. It need not
27 ** explicitly deallocate them. {\Gasman} automatically determines which
28 ** bags are dead and deallocates them. This is done by a process called
29 ** *garbage collection*. Garbage refers to the bags that are dead, and
30 ** collection refers to the process of deallocating them.
31 **
32 ** *Cooperating* means that the application must cooperate with {\Gasman},
33 ** that is it must follow two rules. One rule is that it must not remember
34 ** the addresses of the data area of a bag for too long. The other rule is
35 ** that it must inform {\Gasman} when it has changed a bag.
36 **
37 ** *Compacting* means that after a garbage collection {\Gasman} compacts the
38 ** bags that are still live, so that the storage made available by
39 ** deallocating the dead bags becomes one large contiguous block. This
40 ** helps to avoid *fragmentation* of the free storage. The downside is that
41 ** the address of the data area of a bag may change during a garbage
42 ** collection, which is the reason why the application must not remember
43 ** this address for too long, i.e., must not keep pointers to or into the
44 ** data area of a bag over a garbage collection.
45 **
46 ** *Generational* means that {\Gasman} distinguishes between old and young
47 ** bags. Old bags have been allocated some time ago, i.e., they survived at
48 ** least one garbage collection. During a garbage collection {\Gasman} will
49 ** first find and deallocate the dead young bags. Only if that does not
50 ** produce enough free storage, {\Gasman} will find and deallocate the dead
51 ** old bags. The idea behind this is that usually most bags have a very
52 ** short life, so that they will die young. The downside is that this
53 ** requires {\Gasman} to quickly find the young bags that are referenced
54 ** from old bags, which is the reason why an application must inform
55 ** {\Gasman} when it has changed a bag.
56 **
57 ** *Conservative* means that there are situations in which {\Gasman} cannot
58 ** decide with absolute certainty whether a bag is still live or already
59 ** dead. In these situations {\Gasman} has to assume that the bag is still
60 ** live, and may thus keep a bag longer than it is necessary.
61 **
62 ** What follows describes the reasons for this design, and at the same time
63 ** the assumptions that were made about the application. This is given so
64 ** you can make an educated guess as to whether {\Gasman} is an appropriate
65 ** storage manager for your application.
66 **
67 ** {\Gasman} is automatic, because this makes it easier to use in large or
68 ** complex applications. Namely in with a non-automatic storage manager the
69 ** application must decide when to deallocate a bag. This requires in
70 ** general global knowledge, i.e., it is not sufficient to know whether the
71 ** current function may still need the bag, one also needs to know whether
72 ** any other function may still need the bag. With growing size or
73 ** complexity of the application it gets harder to obtain this knowledge.
74 **
75 ** {\Gasman} is cooperating, because this is a requirement for compaction
76 ** and generations (at least without cooperation, compaction and generations
77 ** are very difficult). As described below, the former is important for
78 ** storage efficiency, the latter for time efficiency. Note that the
79 ** cooperation requires only local knowledge, i.e., whether or not a certain
80 ** function of the application follows the two rules can be decided by just
81 ** looking at the function without any knowledge about the rest of the
82 ** application.
83 **
84 ** {\Gasman} is compacting, because this allows the efficient usage of the
85 ** available storage by applications where the ratio between the size of the
86 ** smallest and the largest bag is large. Namely with a non-compacting
87 ** storage manager, a part of the free storage may become unavailable
88 ** because it is fragmented into many small pieces, each of which is too
89 ** small to serve an allocation.
90 **
91 ** {\Gasman} is generational, because this makes it very much faster, at
92 ** least for those applications where most bags will indeed die young.
93 ** Namely a non-generational storage manager must test for each bag whether
94 ** or not it is still live during each garbage collection. However with
95 ** many applications the probability that an old bag, i.e., one that
96 ** survived at least one garbage collection, will also survive the next
97 ** garbage collection is high. A generational storage manager simply
98 ** assumes that each old bag is still live during most garbage collections.
99 ** Thereby it avoids the expensive tests for most bags during most garbage
100 ** collections.
101 **
102 ** {\Gasman} is conservative, because for most applications only few bags
103 ** are incorrectly assumed to be still live and the additional cooperation
104 ** required to make {\Gasman} (more) precise would slow down the
105 ** application. Note that the problem appears since the C compiler provides
106 ** not enough information to distinguish between true references to bags and
107 ** other values that just happen to look like references. Thus {\Gasman}
108 ** has to assume that everything that could be interpreted as a reference to
109 ** a bag is indeed such a reference, and that this bag is still live.
110 ** Therefore some bags may be kept by {\Gasman}, even though they are
111 ** already dead.
112 */
113
114 #include "gasman.h"
115 #include "gasman_intern.h"
116
117 #include "gaputils.h"
118 #include "io.h"
119 #include "sysfiles.h"
120 #include "sysmem.h"
121
122 #include "bags.inc"
123
124 #ifdef GAP_MEM_CHECK
125 #include <sys/mman.h>
126 #endif
127
128 /****************************************************************************
129 **
130 *F WORDS_BAG( <size> ) . . . . . . . . . . words used by a bag of given size
131 **
132 ** The structure of a bag is a follows{\:}
133 **
134 ** <identifier>
135 ** __/
136 ** /
137 ** V
138 ** +---------+
139 ** |<masterp>|
140 ** +---------+
141 ** \________________________
142 ** \
143 ** V
144 ** +------+-------+------+---------+--------------------------------+----+
145 ** |<size>|<flags>|<type>| <link> | . . ...| pad|
146 ** +------+-------+------+---------+--------------------------------+----+
147 **
148 ** A bag consists of a masterpointer, and a body.
149 **
150 ** The *masterpointer* is a pointer to the data area of the bag. During a
151 ** garbage collection the masterpointer is the only active pointer to the
152 ** data area of the bag, because of the rule that no pointers to or into the
153 ** data area of a bag may be remembered over calls to functions that may
154 ** cause a garbage collection. It is the job of the garbage collection to
155 ** update the masterpointer of a bag when it moves the bag.
156 **
157 ** The *identifier* of the bag is a pointer to (the address of) the
158 ** masterpointer of the bag. Thus 'PTR_BAG(<bag>)' is simply '\*<bag>'
159 ** plus a cast.
160 **
161 ** The *body* of a bag consists of a header, the data area, and the padding.
162 **
163 ** The header in turn consists of the *type byte*, *flags byte* and the
164 ** *size field*, which is either 32 bits or 48 bits (on 32 resp. 64 bit systems),
165 ** followed by a link word. The 'BagHeader' struct describes the exact
166 ** structure of the header.
167 **
168 ** The *link word* usually contains the identifier of the bag, i.e., a
169 ** pointer to the masterpointer of the bag. Thus the garbage collection can
170 ** find the masterpointer of a bag through the link word if it knows the
171 ** address of the data area of the bag. The link word is also used by
172 ** {\Gasman} to keep bags on two linked lists (see "ChangedBags" and
173 ** "MarkedBags").
174 **
175 ** The *data area* of a bag is the area that contains the data stored by
176 ** the application in this bag.
177 **
178 ** The *padding* consists of up to 'sizeof(Bag)-1' bytes and pads the body
179 ** so that the size of a body is always a multiple of 'sizeof(Bag)'. This
180 ** is to ensure that bags are always aligned. The macro 'WORDS_BAG(<size>)'
181 ** returns the number of words occupied by the data area and padding of a
182 ** bag of size <size>.
183 **
184 ** A body in the workspace whose type byte contains the value T_DUMMY is the
185 ** remainder of a 'ResizeBag'. That is it consists either of the unused words
186 ** after a bag has been shrunk, or of the old body of the bag after the
187 ** contents of the body have been copied elsewhere for an extension. The
188 ** size field in the bag header contains the number of bytes in
189 ** this area excluding the first word itself. Note that such a body has no
190 ** link word, because such a remainder does not correspond to a bag (see
191 ** "Implementation of ResizeBag").
192 **
193 ** A masterpointer with a value congruent to 1 mod 4 is the relic of an
194 ** object that was weakly but not strongly marked in a recent garbage
195 ** collection. These persist until after the next full garbage collection
196 ** by which time all references to them should have been removed.
197 **
198 */
199
200 enum {
201 SIZE_MPTR_BAGS = 1,
202
203 T_DUMMY = NUM_TYPES - 1,
204 };
205
206
207 // BAG_SLACK is used to define a block of empty space at the end of each
208 // bag, which can then be marked as "not accessible" in the memory checker
209 // Valgrind
210
211 enum { BAG_SLACK = 0 };
212
213 // TIGHT_WORDS_BAG defines the actual amount of space a Bag requires,
214 // without BAG_SLACK.
TIGHT_WORDS_BAG(UInt size)215 static inline UInt TIGHT_WORDS_BAG(UInt size)
216 {
217 return (size + sizeof(Bag) - 1) / sizeof(Bag);
218 }
219
WORDS_BAG(UInt size)220 static inline UInt WORDS_BAG(UInt size)
221 {
222 return TIGHT_WORDS_BAG(size) + BAG_SLACK;
223 }
224
DATA(BagHeader * bag)225 static inline Bag *DATA(BagHeader *bag)
226 {
227 return (Bag *)(bag + 1);
228 }
229
230
231 /****************************************************************************
232 **
233 *V MptrBags . . . . . . . . . . . . . . beginning of the masterpointer area
234 *V MptrEndBags . . . . . . . . . . . . . . . end of the masterpointer area
235 *V OldBags . . . . . . . . . . . . . . . . . beginning of the old bags area
236 *V YoungBags . . . . . . . . . . . . . . . beginning of the young bags area
237 *V AllocBags . . . . . . . . . . . . . . . beginning of the allocation area
238 *V AllocSizeBags . . . . . . . . . . . . . . . . size of the allocation area
239 *V EndBags . . . . . . . . . . . . . . . . . . . . . . end of the workspace
240 **
241 ** {\Gasman} manages one large block of storage called the *workspace*. The
242 ** layout of the workspace is as follows{\:}
243 **
244 ** +----------------+----------+----------+-----------------+--------------+
245 ** | masterpointer | unused | old bags | young bags | allocation |
246 ** | area | area | area | area | area |
247 ** +----------------+----------+----------+-----------------+--------------+
248 ** ^ ^ ^ ^ ^ ^
249 ** MptrBags MptrEndBags OldBags YoungBags AllocBags EndBags
250 **
251 ** The *masterpointer area* contains all the masterpointers of the bags.
252 ** 'MptrBags' points to the beginning of this area and 'MptrEndBags' to the
253 ** end.
254 **
255 ** Between MptrEndBags and OldBags is an *unused area*. This exists so the
256 ** master points, and bags area, can be moved independently. MptrEndBags
257 ** will always come earlier in memory than OldBags. GASMAN should not touch
258 ** this memory, as it may be used for other purposes.
259 **
260 ** The *old bags area* contains the bodies of all the bags that survived at
261 ** least one garbage collection. This area is only scanned for dead bags
262 ** during a full garbage collection. 'OldBags' points to the beginning of
263 ** this area and 'YoungBags' to the end.
264 **
265 ** The *young bags area* contains the bodies of all the bags that have been
266 ** allocated since the last garbage collection. This area is scanned for
267 ** dead bags during each garbage collection. 'YoungBags' points to the
268 ** beginning of this area and 'AllocBags' to the end.
269 **
270 ** The *allocation area* is the storage that is available for allocation of
271 ** new bags. When a new bag is allocated the storage for the body is taken
272 ** from the beginning of this area, and this area is correspondingly
273 ** reduced. If the body does not fit in the allocation area a garbage
274 ** collection is performed. 'AllocBags' points to the beginning of this
275 ** area and 'EndBags' to the end.
276 **
277 ** Note that the borders between the areas are not static. In particular
278 ** each allocation increases the size of the young bags area and reduces the
279 ** size of the allocation area. On the other hand each garbage collection
280 ** empties the young bags area.
281 */
282 Bag * MptrBags;
283 Bag * MptrEndBags;
284 static Bag * OldBags;
285 Bag * YoungBags;
286 Bag * AllocBags;
287 static UInt AllocSizeBags;
288 static Bag * EndBags;
289
290 /* These macros, are (a) for more readable code, but more importantly
291 (b) to ensure that unsigned subtracts and divides are used (since
292 we know the ordering of the pointers. This is needed on > 2GB
293 workspaces on 32 but systems. The Size****Area functions return an
294 answer in units of a word (ie sizeof(UInt) bytes), which should
295 therefore be small enough not to cause problems. */
296
SpaceBetweenPointers(const Bag * a,const Bag * b)297 static inline UInt SpaceBetweenPointers(const Bag * a, const Bag * b)
298 {
299 GAP_ASSERT(b <= a);
300 UInt res = (((UInt)((UInt)(a) - (UInt)(b))) / sizeof(Bag));
301 return res;
302 }
303
304 #define SizeMptrsArea SpaceBetweenPointers(MptrEndBags, MptrBags)
305 // #define SizeOldBagsArea SpaceBetweenPointers(YoungBags, OldBags)
306 // #define SizeYoungBagsArea SpaceBetweenPointers(AllocBags, YoungBags)
307 #define SizeAllocationArea SpaceBetweenPointers(EndBags, AllocBags)
308
309 #define SizeAllBagsArea SpaceBetweenPointers(AllocBags, OldBags)
310 #define SizeWorkspace SpaceBetweenPointers(EndBags, MptrBags)
311
312 #if defined(GAP_KERNEL_DEBUG)
SanityCheckGasmanPointers(void)313 static int SanityCheckGasmanPointers(void)
314 {
315 return MptrBags <= MptrEndBags &&
316 MptrEndBags <= OldBags &&
317 OldBags <= YoungBags &&
318 YoungBags <= AllocBags &&
319 AllocBags <= EndBags;
320 }
321 #endif
322
323 /****************************************************************************
324 **
325 *V FreeMptrBags . . . . . . . . . . . . . . . list of free bag identifiers
326 **
327 ** 'FreeMptrBags' is the first free bag identifier, i.e., it points to the
328 ** first available masterpointer. If 'FreeMptrBags' is 0 there are no
329 ** available masterpointers. The available masterpointers are managed in a
330 ** forward linked list, i.e., each available masterpointer points to the
331 ** next available masterpointer, except for the last, which contains 0.
332 **
333 ** When a new bag is allocated it gets the identifier 'FreeMptrBags', and
334 ** 'FreeMptrBags' is set to the value stored in this masterpointer, which is
335 ** the next available masterpointer. When a bag is deallocated by a garbage
336 ** collection its masterpointer is added to the list of available
337 ** masterpointers again.
338 */
339 static Bag FreeMptrBags;
340
341
342 /****************************************************************************
343 **
344 *V ChangedBags . . . . . . . . . . . . . . . . . . list of changed old bags
345 **
346 ** 'ChangedBags' holds a list of old bags that have been changed since the
347 ** last garbage collection, i.e., for which either 'CHANGED_BAG' was called
348 ** or which have been resized.
349 **
350 ** This list starts with the bag whose identifier is 'ChangedBags', and the
351 ** link word of each bag on the list contains the identifier of the next bag
352 ** on the list. The link word of the last bag on the list contains 0. If
353 ** 'ChangedBags' has the value 0, the list is empty.
354 **
355 ** The garbage collection needs to know which young bags are subbags of old
356 ** bags, since it must not throw those away in a partial garbage
357 ** collection. Only those old bags that have been changed since the last
358 ** garbage collection can contain references to young bags, which have been
359 ** allocated since the last garbage collection. The application cooperates
360 ** by informing {\Gasman} with 'CHANGED_BAG' which bags it has changed. The
361 ** list of changed old bags is scanned by a partial garbage collection and
362 ** the young subbags of the old bags on this list are marked with 'MarkBag'
363 ** (see "MarkedBags"). Without this list 'CollectBags' would have to scan
364 ** all old bags for references to young bags, which would take too much time
365 ** (see "Implementation of CollectBags").
366 **
367 ** 'CHANGED_BAG' puts a bag on the list of changed old bags. 'CHANGED_BAG'
368 ** first checks that <bag> is an old bag by checking that 'PTR_BAG( <bag> )'
369 ** is smaller than 'YoungBags'. Then it checks that the bag is not already
370 ** on the list of changed bags by checking that the link word still contains
371 ** the identifier of <bag>. If <bag> is an old bag that is not already on
372 ** the list of changed bags, 'CHANGED_BAG' puts <bag> on the list of changed
373 ** bags, by setting the link word of <bag> to the current value of
374 ** 'ChangedBags' and then setting 'ChangedBags' to <bag>.
375 */
376 Bag ChangedBags;
377
378
379 /****************************************************************************
380 **
381 *V MarkedBags . . . . . . . . . . . . . . . . . . . . . list of marked bags
382 **
383 ** 'MarkedBags' holds a list of bags that have already been marked during a
384 ** garbage collection by 'MarkBag'. This list is only used during garbage
385 ** collections, so it is always empty outside of garbage collections (see
386 ** "Implementation of CollectBags").
387 **
388 ** This list starts with the bag whose identifier is 'MarkedBags', and the
389 ** link word of each bag on the list contains the identifier of the next bag
390 ** on the list. The link word of the last bag on the list contains 0. If
391 ** 'MarkedBags' has the value 0, the list is empty.
392 **
393 ** Note that some other storage managers do not use such a list during the
394 ** mark phase. Instead they simply let the marking functions call each
395 ** other. While this is somewhat simpler it may use an unbound amount of
396 ** space on the stack. This is particularly bad on systems where the stack
397 ** is not in a separate segment of the address space, and thus may grow into
398 ** the workspace, causing disaster.
399 **
400 ** 'MarkBag' puts a bag <bag> onto this list. 'MarkBag' has to be
401 ** careful, because it can be called with an argument that is not really a
402 ** bag identifier, and may point outside the programs address space. So
403 ** 'MarkBag' first checks that <bag> points to a properly aligned location
404 ** between 'MptrBags' and 'OldBags'. Then 'MarkBag' checks that <bag> is
405 ** the identifier of a young bag by checking that the masterpointer points
406 ** to a location between 'YoungBags' and 'AllocBags' (if <bag> is the
407 ** identifier of an old bag, the masterpointer will point to a location
408 ** between 'OldBags' and 'YoungBags', and if <bag> only appears to be an
409 ** identifier, the masterpointer could be on the free list of masterpointers
410 ** and point to a location between 'MptrBags' and 'OldBags'). Then
411 ** 'MarkBag' checks that <bag> is not already marked by checking that the
412 ** link word of <bag> contains the identifier of the bag. If any of the
413 ** checks fails, 'MarkBag' does nothing. If all checks succeed, 'MarkBag'
414 ** puts <bag> onto the list of marked bags by putting the current value of
415 ** 'ChangedBags' into the link word of <bag> and setting 'ChangedBags' to
416 ** <bag>. Note that since bags are always placed at the front of the list,
417 ** 'CollectBags' will mark the bags in a depth-first order. This is
418 ** probably good to improve the locality of reference.
419 */
420 static Bag MarkedBags;
421
422
423 /****************************************************************************
424 **
425 *V NrAllBags . . . . . . . . . . . . . . . . . number of all bags allocated
426 *V NrLiveBags . . . . . . . . . . number of bags that survived the last gc
427 *V SizeLiveBags . . . . . . . total size of bags that survived the last gc
428 *V NrDeadBags . . . . . . . number of bags that died since the last full gc
429 *V SizeDeadBags . . . . total size of bags that died since the last full gc
430 *V NrHalfDeadBags . . . . . number of bags that died since the last full gc
431 ** but may still be weakly pointed to
432 */
433 UInt NrAllBags;
434 UInt NrLiveBags;
435 UInt SizeLiveBags;
436 UInt NrDeadBags;
437 UInt8 SizeDeadBags;
438 UInt NrHalfDeadBags;
439
440
441 /****************************************************************************
442 **
443 *F IS_BAG_ID -- check if a value looks like a masterpointer id
444 */
IS_BAG_ID(void * ptr)445 static inline UInt IS_BAG_ID(void * ptr)
446 {
447 return (((void *)MptrBags <= ptr) && (ptr < (void *)MptrEndBags) &&
448 ((UInt)ptr & (sizeof(Bag) - 1)) == 0);
449 }
450
451 /****************************************************************************
452 **
453 *F IS_BAG_BODY -- check if value like a pointer to a bag body
454 */
IS_BAG_BODY(void * ptr)455 static inline UInt IS_BAG_BODY(void * ptr)
456 {
457 return (((void *)OldBags <= ptr) && (ptr < (void *)AllocBags) &&
458 ((UInt)ptr & (sizeof(Bag) - 1)) == 0);
459 }
460
461 #if defined(GAP_MEMORY_CANARY)
462
463 #include <valgrind/valgrind.h>
464 #include <valgrind/memcheck.h>
465
466 // tell valgrind that the masterpointer, bag contents and bag header of Bag
467 // should all be accessible
CANARY_ALLOW_ACCESS_BAG(Bag bag)468 static void CANARY_ALLOW_ACCESS_BAG(Bag bag)
469 {
470 VALGRIND_MAKE_MEM_DEFINED(bag, sizeof(Bag));
471 char * ptr = (char *)PTR_BAG(bag);
472 Int bagLength = SIZE_BAG(bag);
473 VALGRIND_MAKE_MEM_DEFINED(ptr, bagLength);
474
475 BagHeader * header = BAG_HEADER(bag);
476 VALGRIND_MAKE_MEM_DEFINED(
477 header, sizeof(*header) - sizeof(header->memory_canary_padding));
478 }
479
480 // Reverse CANARY_ALL_ACCESS_BAG, making the masterpointer, bag contents and
481 // bag header all inaccessible
CANARY_FORBID_ACCESS_BAG(Bag bag)482 static void CANARY_FORBID_ACCESS_BAG(Bag bag)
483 {
484 VALGRIND_MAKE_MEM_NOACCESS(bag, sizeof(Bag));
485 char * ptr = (char *)PTR_BAG(bag);
486 Int bagLength = SIZE_BAG(bag);
487 VALGRIND_MAKE_MEM_NOACCESS(ptr, bagLength);
488
489 BagHeader * header = BAG_HEADER(bag);
490 VALGRIND_MAKE_MEM_NOACCESS(
491 header, sizeof(*header) - sizeof(header->memory_canary_padding));
492 }
493
494 // Mark all bags as accessible
CANARY_ALLOW_ACCESS_ALL_BAGS(void)495 static void CANARY_ALLOW_ACCESS_ALL_BAGS(void)
496 {
497 CallbackForAllBags(CANARY_ALLOW_ACCESS_BAG);
498 }
499
500 // Mark all bags as inaccessible
CANARY_FORBID_ACCESS_ALL_BAGS(void)501 static void CANARY_FORBID_ACCESS_ALL_BAGS(void)
502 {
503 VALGRIND_MAKE_MEM_NOACCESS(MptrBags, (EndBags - MptrBags) * sizeof(Bag));
504 }
505
506 // Temporarily disable valgrind checking. This is used while creating bags or
507 // adjusting any internal GASMAN structures
508 #define CANARY_DISABLE_VALGRIND() VALGRIND_DISABLE_ERROR_REPORTING
509
510 // Renable valgrind checking.
511 #define CANARY_ENABLE_VALGRIND() VALGRIND_ENABLE_ERROR_REPORTING
512
513 // CHANGED_BAG must be here to disable/enable valgrind
CHANGED_BAG(Bag bag)514 void CHANGED_BAG(Bag bag)
515 {
516 CANARY_DISABLE_VALGRIND();
517 if (CONST_PTR_BAG(bag) <= YoungBags && LINK_BAG(bag) == bag) {
518 LINK_BAG(bag) = ChangedBags;
519 ChangedBags = bag;
520 }
521 CANARY_ENABLE_VALGRIND();
522 }
523 #else
524 #define CANARY_DISABLE_VALGRIND()
525 #define CANARY_ENABLE_VALGRIND()
526 #define CANARY_ALLOW_ACCESS_BAG(b)
527 #define CANARY_FORBID_ACCESS_BAG(b)
528 #define CANARY_ALLOW_ACCESS_ALL_BAGS()
529 #define CANARY_FORBID_ACCESS_ALL_BAGS()
530 #endif
531
532
533 /****************************************************************************
534 **
535 *F InitSweepFuncBags(<type>,<mark-func>) . . . . install sweeping function
536 */
537
538 static TNumSweepFuncBags TabSweepFuncBags[NUM_TYPES];
539
540
InitSweepFuncBags(UInt type,TNumSweepFuncBags sweep_func)541 void InitSweepFuncBags (
542 UInt type,
543 TNumSweepFuncBags sweep_func )
544 {
545 if ( TabSweepFuncBags[type] != 0 ) {
546 Pr("warning: sweep function for type %d already installed\n", type, 0);
547 }
548
549 TabSweepFuncBags[type] = sweep_func;
550 }
551
552
553 /****************************************************************************
554 **
555 *F InitMarkFuncBags(<type>,<mark-func>) . . . . . install marking function
556 *F MarkNoSubBags(<bag>) . . . . . . . . marking function that marks nothing
557 *F MarkOneSubBags(<bag>) . . . . . . marking function that marks one subbag
558 *F MarkTwoSubBags(<bag>) . . . . . . marking function that marks two subbags
559 *F MarkThreeSubBags(<bag>) . . . . marking function that marks three subbags
560 *F MarkFourSubBags(<bag>) . . . . marking function that marks four subbags
561 *F MarkAllSubBags(<bag>) . . . . . . marking function that marks everything
562 **
563 ** 'InitMarkFuncBags', 'MarkNoSubBags', 'MarkOneSubBags', 'MarkTwoSubBags',
564 ** and 'MarkAllSubBags' are really too simple for an explanation.
565 **
566 ** 'MarkAllSubBagsDefault' is the same as 'MarkAllSubBags' but is only used
567 ** by GASMAN as default. This will allow to catch type clashes.
568 */
569
570 TNumMarkFuncBags TabMarkFuncBags [ NUM_TYPES ];
571
InitMarkFuncBags(UInt type,TNumMarkFuncBags mark_func)572 void InitMarkFuncBags (
573 UInt type,
574 TNumMarkFuncBags mark_func )
575 {
576 if ( TabMarkFuncBags[type] != MarkAllSubBagsDefault ) {
577 Pr("warning: mark function for type %d already installed\n", type, 0);
578 }
579
580 TabMarkFuncBags[type] = mark_func;
581 }
582
583 enum {
584 DEAD = 0,
585 ALIVE = 1,
586 HALFDEAD = 2,
587 };
588
GET_MARK_BITS(Bag x)589 static inline UInt GET_MARK_BITS(Bag x)
590 {
591 return (UInt)x & (sizeof(Bag) - 1);
592 }
593
MARKED_DEAD(Bag x)594 static inline Bag MARKED_DEAD(Bag x)
595 {
596 return x;
597 }
598
MARKED_ALIVE(Bag x)599 static inline Bag MARKED_ALIVE(Bag x)
600 {
601 return (Bag)((UInt)x | ALIVE);
602 }
603
MARKED_HALFDEAD(Bag x)604 static inline Bag MARKED_HALFDEAD(Bag x)
605 {
606 return (Bag)((UInt)x | HALFDEAD);
607 }
608
IS_MARKED_DEAD(Bag x)609 static inline Int IS_MARKED_DEAD(Bag x)
610 {
611 return LINK_BAG(x) == MARKED_DEAD(x);
612 }
613
614 // static inline Int IS_MARKED_ALIVE(Bag x)
615 // {
616 // return LINK_BAG(x) == MARKED_ALIVE(x);
617 // }
618
IS_MARKED_HALFDEAD(Bag x)619 static inline Int IS_MARKED_HALFDEAD(Bag x)
620 {
621 return LINK_BAG(x) == MARKED_HALFDEAD(x);
622 }
623
624 #ifdef DEBUG_MASTERPOINTERS
UNMARKED_DEAD(Bag x)625 static inline Bag UNMARKED_DEAD(Bag x)
626 {
627 GAP_ASSERT(GET_MARK_BITS(x) == DEAD);
628 return x;
629 }
630 #endif
631
UNMARKED_ALIVE(Bag x)632 static inline Bag UNMARKED_ALIVE(Bag x)
633 {
634 GAP_ASSERT(GET_MARK_BITS(x) == ALIVE);
635 return (Bag)(((UInt)x) & ~ALIVE);
636 }
637
UNMARKED_HALFDEAD(Bag x)638 static inline Bag UNMARKED_HALFDEAD(Bag x)
639 {
640 GAP_ASSERT(GET_MARK_BITS(x) == HALFDEAD);
641 return (Bag)(((UInt)x) & ~HALFDEAD);
642 }
643
644
645 #ifdef DEBUG_GASMAN_MARKING
646 static UInt BadMarksCounter = 0;
647 static Int DisableMarkBagValidation = 0;
648 #endif
649
650
651 // We define MarkBag as a inline function here so that
652 // the compiler can optimize the marking functions using it in the
653 // "current translation unit", i.e. inside gasman.c.
654 // Other marking functions don't get to inline MarkBag calls anymore,
655 // but luckily these are rare (and usually not performance critical
656 // to start with).
MarkBag(Bag bag)657 inline void MarkBag(Bag bag)
658 {
659 if ( IS_BAG_ID(bag)
660 && YoungBags < CONST_PTR_BAG(bag) /* points to a young bag */
661 && CONST_PTR_BAG(bag) <= AllocBags /* " " " " " */
662 && (IS_MARKED_DEAD(bag) || IS_MARKED_HALFDEAD(bag)) )
663 {
664 LINK_BAG(bag) = MarkedBags;
665 MarkedBags = bag;
666 }
667 #ifdef DEBUG_GASMAN_MARKING
668 else if (!DisableMarkBagValidation) {
669 if (bag != 0 && !((UInt)bag & 3) && !IS_BAG_ID(bag)) {
670 BadMarksCounter++;
671 }
672 }
673 #endif
674 }
675
MarkBagWeakly(Bag bag)676 void MarkBagWeakly(Bag bag)
677 {
678 if ( IS_BAG_ID(bag)
679 && YoungBags < CONST_PTR_BAG(bag) /* points to a young bag */
680 && CONST_PTR_BAG(bag) <= AllocBags /* " " " " " */
681 && IS_MARKED_DEAD(bag) ) /* and not marked already */
682 {
683 // mark it now as we don't have to recurse
684 LINK_BAG(bag) = MARKED_HALFDEAD(bag);
685 }
686 }
687
IsWeakDeadBag(Bag bag)688 Int IsWeakDeadBag(Bag bag)
689 {
690 CANARY_DISABLE_VALGRIND();
691 Int isWeakDeadBag = (((UInt)bag & (sizeof(Bag) - 1)) == 0) &&
692 (Bag)MptrBags <= bag && bag < (Bag)MptrEndBags &&
693 (((UInt)*bag) & (sizeof(Bag) - 1)) == 1;
694 CANARY_ENABLE_VALGRIND();
695 return isWeakDeadBag;
696 }
697
698
699 /****************************************************************************
700 **
701 *F CallbackForAllBags( <func> ) call a C function on all non-zero mptrs
702 **
703 ** This calls a C function on every bag, including garbage ones, by simply
704 ** walking the masterpointer area. Not terribly safe.
705 **
706 */
CallbackForAllBags(void (* func)(Bag))707 void CallbackForAllBags(void (*func)(Bag))
708 {
709 for (Bag bag = (Bag)MptrBags; bag < (Bag)MptrEndBags; bag++) {
710 CANARY_DISABLE_VALGRIND();
711 Int is_bag = IS_BAG_BODY(*bag);
712 CANARY_ENABLE_VALGRIND();
713 if (is_bag) {
714 (*func)(bag);
715 }
716 }
717 }
718
719
720 /****************************************************************************
721 **
722 *V GlobalBags . . . . . . . . . . . . . . . . . . . . . list of global bags
723 */
724 TNumGlobalBags GlobalBags;
725
726
727 /****************************************************************************
728 **
729 *F InitGlobalBag(<addr>, <cookie>) inform Gasman about global bag identifier
730 **
731 ** 'InitGlobalBag' simply leaves the address <addr> in a global array, where
732 ** it is used by 'CollectBags'. <cookie> is also recorded to allow things to
733 ** be matched up after loading a saved workspace.
734 */
735 static UInt GlobalSortingStatus;
736
ClearGlobalBags(void)737 static void ClearGlobalBags(void)
738 {
739 UInt i;
740 for (i = 0; i < GlobalBags.nr; i++)
741 {
742 GlobalBags.addr[i] = 0L;
743 GlobalBags.cookie[i] = 0L;
744 }
745 GlobalBags.nr = 0;
746 GlobalSortingStatus = 0;
747 }
748
InitGlobalBag(Bag * addr,const Char * cookie)749 void InitGlobalBag (
750 Bag * addr,
751 const Char * cookie )
752 {
753
754 if ( GlobalBags.nr == NR_GLOBAL_BAGS ) {
755 Panic("Gasman cannot handle so many global variables");
756 }
757
758 if (cookie != 0) {
759 for (UInt i = 0; i < GlobalBags.nr; i++) {
760 if (0 == strcmp(GlobalBags.cookie[i], cookie)) {
761 if (GlobalBags.addr[i] == addr)
762 Pr("Duplicate global bag entry %s\n", (Int)cookie, 0L);
763 else
764 Pr("Duplicate global bag cookie %s\n", (Int)cookie, 0L);
765 }
766 }
767 }
768
769 GlobalBags.addr[GlobalBags.nr] = addr;
770 GlobalBags.cookie[GlobalBags.nr] = cookie;
771 GlobalBags.nr++;
772 GlobalSortingStatus = 0;
773 }
774
775
IsLessGlobal(const Char * cookie1,const Char * cookie2,UInt byWhat)776 static Int IsLessGlobal (
777 const Char * cookie1,
778 const Char * cookie2,
779 UInt byWhat )
780 {
781 if (byWhat != 2)
782 {
783 Panic("can only sort globals by cookie");
784 }
785 if (cookie1 == 0L && cookie2 == 0L)
786 return 0;
787 if (cookie1 == 0L)
788 return -1;
789 if (cookie2 == 0L)
790 return 1;
791 return strcmp(cookie1, cookie2) < 0;
792 }
793
794
795
SortGlobals(UInt byWhat)796 void SortGlobals( UInt byWhat )
797 {
798 const Char *tmpcookie;
799 Bag * tmpaddr;
800 UInt len, h, i, k;
801 if (byWhat != 2)
802 {
803 Panic("can only sort globals by cookie");
804 }
805 if (GlobalSortingStatus == byWhat)
806 return;
807 len = GlobalBags.nr;
808 h = 1;
809 while ( 9*h + 4 < len )
810 { h = 3*h + 1; }
811 while ( 0 < h ) {
812 for ( i = h; i < len; i++ ) {
813 tmpcookie = GlobalBags.cookie[i];
814 tmpaddr = GlobalBags.addr[i];
815 k = i;
816 while ( h <= k && IsLessGlobal(tmpcookie,
817 GlobalBags.cookie[k-h],
818 byWhat))
819 {
820 GlobalBags.cookie[k] = GlobalBags.cookie[k-h];
821 GlobalBags.addr[k] = GlobalBags.addr[k-h];
822 k -= h;
823 }
824 GlobalBags.cookie[k] = tmpcookie;
825 GlobalBags.addr[k] = tmpaddr;
826 }
827 h = h / 3;
828 }
829 GlobalSortingStatus = byWhat;
830 }
831
832
833
GlobalByCookie(const Char * cookie)834 Bag * GlobalByCookie(
835 const Char * cookie )
836 {
837 UInt i,top,bottom,middle;
838 Int res;
839 if (cookie == 0)
840 Panic("zero cookie passed to GlobalByCookie");
841 if (GlobalSortingStatus != 2)
842 {
843 for (i = 0; i < GlobalBags.nr; i++)
844 {
845 if (strcmp(cookie, GlobalBags.cookie[i]) == 0)
846 return GlobalBags.addr[i];
847 }
848 return (Bag *)0L;
849 }
850 else
851 {
852 top = GlobalBags.nr;
853 bottom = 0;
854 while (top >= bottom) {
855 middle = (top + bottom)/2;
856 res = strcmp(cookie,GlobalBags.cookie[middle]);
857 if (res < 0)
858 top = middle-1;
859 else if (res > 0)
860 bottom = middle+1;
861 else
862 return GlobalBags.addr[middle];
863 }
864 return (Bag *)0L;
865 }
866 }
867
868
869 static Bag NextMptrRestoring;
870
StartRestoringBags(UInt nBags,UInt maxSize)871 void StartRestoringBags( UInt nBags, UInt maxSize)
872 {
873 UInt target;
874 Bag *newmem;
875 /*Bag *ptr; */
876 target = (8*nBags)/7 + (8*maxSize)/7; /* ideal workspace size */
877 target = (target * sizeof (Bag) + (512L*1024L) - 1)/(512L*1024L)*(512L*1024L)/sizeof (Bag);
878 /* make sure that the allocated amount of memory is divisible by 512 * 1024 */
879 if (SizeWorkspace < target)
880 {
881 newmem = SyAllocBags(sizeof(Bag)*(target- SizeWorkspace)/1024, 0);
882 if (newmem == 0)
883 {
884 target = nBags + maxSize; /* absolute requirement */
885 target = (target * sizeof (Bag) + (512L*1024L) - 1)/(512L*1024L)*(512L*1024L)/sizeof (Bag);
886 /* make sure that the allocated amount of memory is divisible by 512 * 1024 */
887 if (SizeWorkspace < target)
888 SyAllocBags(sizeof(Bag)*(target- SizeWorkspace)/1024, 1);
889 }
890 EndBags = MptrBags + target;
891 }
892 OldBags = MptrBags + nBags + (SizeWorkspace - nBags - maxSize)/8;
893 MptrEndBags = OldBags;
894 AllocBags = OldBags;
895 NextMptrRestoring = (Bag)MptrBags;
896 SizeAllBags = 0;
897 NrAllBags = 0;
898 }
899
NextBagRestoring(UInt type,UInt flags,UInt size)900 Bag NextBagRestoring( UInt type, UInt flags, UInt size )
901 {
902 Bag bag;
903 UInt i;
904 BagHeader * header = (BagHeader *)AllocBags;
905 *(Bag **)NextMptrRestoring = AllocBags = DATA(header);
906 bag = NextMptrRestoring;
907 header->type = type;
908 header->flags = flags;
909 header->size = size;
910 header->link = NextMptrRestoring;
911
912 NextMptrRestoring++;
913
914 if ((Bag *)NextMptrRestoring >= MptrEndBags)
915 Panic("Overran Masterpointer area");
916
917 for (i = 0; i < WORDS_BAG(size); i++)
918 *AllocBags++ = (Bag)0;
919
920 if (AllocBags > EndBags)
921 Panic("Overran data area");
922
923 #ifdef COUNT_BAGS
924 InfoBags[type].nrLive += 1;
925 InfoBags[type].nrAll += 1;
926 InfoBags[type].sizeLive += size;
927 InfoBags[type].sizeAll += size;
928 #endif
929 SizeAllBags += size;
930 NrAllBags ++;
931 return bag;
932 }
933
FinishedRestoringBags(void)934 void FinishedRestoringBags( void )
935 {
936 Bag p;
937 /* Bag *ptr; */
938 YoungBags = AllocBags;
939 FreeMptrBags = NextMptrRestoring;
940 for (p = NextMptrRestoring; p +1 < (Bag)MptrEndBags; p++)
941 *(Bag *)p = p+1;
942 *p = 0;
943 NrLiveBags = NrAllBags;
944 SizeLiveBags = SizeAllBags;
945 NrDeadBags = 0;
946 SizeDeadBags = 0;
947 NrHalfDeadBags = 0;
948 ChangedBags = 0;
949 }
950
951
952 /****************************************************************************
953 **
954 *F InitFreeFuncBag(<type>,<free-func>) . . . . . . install freeing function
955 **
956 ** 'InitFreeFuncBag' is really too simple for an explanation.
957 */
958 static TNumFreeFuncBags TabFreeFuncBags[NUM_TYPES];
959
InitFreeFuncBag(UInt type,TNumFreeFuncBags free_func)960 void InitFreeFuncBag (
961 UInt type,
962 TNumFreeFuncBags free_func )
963 {
964 TabFreeFuncBags[type] = free_func;
965 }
966
967
968 /****************************************************************************
969 **
970 */
971 static struct {
972 UInt nrBefore;
973 UInt nrAfter;
974
975 TNumCollectFuncBags before[16];
976 TNumCollectFuncBags after[16];
977 } CollectFuncBags = { 0, 0, { 0 }, { 0 } };
978
RegisterBeforeCollectFuncBags(TNumCollectFuncBags func)979 int RegisterBeforeCollectFuncBags(TNumCollectFuncBags func)
980 {
981 if (CollectFuncBags.nrBefore >= ARRAY_SIZE(CollectFuncBags.before))
982 return 1;
983 CollectFuncBags.before[CollectFuncBags.nrBefore++] = func;
984 return 0;
985 }
986
RegisterAfterCollectFuncBags(TNumCollectFuncBags func)987 int RegisterAfterCollectFuncBags(TNumCollectFuncBags func)
988 {
989 if (CollectFuncBags.nrAfter >= ARRAY_SIZE(CollectFuncBags.after))
990 return 1;
991 CollectFuncBags.after[CollectFuncBags.nrAfter++] = func;
992 return 0;
993 }
994
995
996 /***************************************************************
997 * GAP_MEM_CHECK
998 *
999 * One of the hardest categories of bugs to fix in GAP are where
1000 * a reference to the internals of a GAP object are kept across
1001 * a garbage collection (which moves GAP objects around).
1002 *
1003 * GAP_MEM_CHECK provides a method of detecting such problems, at
1004 * the cost of GREATLY decreased performance (Starting GAP in
1005 * --enableMemCheck mode takes days, rather than seconds).
1006 *
1007 * The fundamental idea behind GAP_MEM_CHECK is, whenever NewBag
1008 * or ResizeBag is called, then the contents of every Bag in
1009 * GAP is moved, and the memory previously being used is marked
1010 * as not readable or writable using 'mprotect'.
1011 *
1012 * Actually copying all GAP's memory space would be extremely
1013 * expensive, so instead we use 'mmap' to set up a set of copies
1014 * of the GAP memory space, which are represented by the same
1015 * underlying physical memory.
1016 *
1017 * The 0th such copy (which we also ensure is the one at the
1018 * lowest memory address) is special -- this is where we
1019 * reference the master pointers (which can't move). We do not
1020 * 'mprotect' any of this memory.
1021 *
1022 * Every time we call 'NewBag' or 'ResizeBag', we change which
1023 * copy of the GASMAN memory space the master pointers point
1024 * to, disabling access to the previous copy, and enabling access
1025 * to the new one.
1026 *
1027 * We never use the master pointers in any copy other than the
1028 * 0th, and we never refer to the Bag area in the 0th copy. However,
1029 * it simplifies things to not try to seperate the master pointer
1030 * and Bag areas, because the master pointer area can grow as GAP
1031 * runs.
1032 *
1033 * Because this code is VERY slow, it can be turned on and off.
1034 * At run time, call GASMAN_MEM_CHECK(1) to enable, and
1035 * GASMAN_MEM_CHECK(0) to disable. Start GAP with --enableMemCheck
1036 * to enable from when GAP starts.
1037 */
1038
1039 #ifdef GAP_MEM_CHECK
1040
1041 Int EnableMemCheck = 0;
1042
enableMemCheck(Char ** argv,void * dummy)1043 Int enableMemCheck(Char ** argv, void * dummy)
1044 {
1045 SyFputs( "# Warning: --enableMemCheck causes SEVERE slowdowns. Starting GAP may take several days!\n", 3 );
1046 EnableMemCheck = 1;
1047 return 1;
1048 }
1049
MoveBagMemory(char * oldbase,char * newbase)1050 static void MoveBagMemory(char * oldbase, char * newbase)
1051 {
1052 Int moveSize = (newbase - oldbase) / sizeof(Bag);
1053 // update the masterpointers
1054 for (Bag * p = MptrBags; p < MptrEndBags; p++) {
1055 if ((Bag)MptrEndBags <= *p)
1056 *p += moveSize;
1057 }
1058
1059 // update 'OldBags', 'YoungBags', 'AllocBags', and 'EndBags'
1060 OldBags += moveSize;
1061 YoungBags += moveSize;
1062 AllocBags += moveSize;
1063 EndBags += moveSize;
1064 }
1065
MaybeMoveBags(void)1066 static void MaybeMoveBags(void)
1067 {
1068 static Int oldBase = 0;
1069
1070 if (!EnableMemCheck)
1071 return;
1072
1073 Int newBase = oldBase + 1;
1074 // Memory buffer 0 is special, as we use that
1075 // copy for the master pointers. Therefore never
1076 // block access to it, and skip it when cycling.
1077 if (newBase >= GetMembufCount())
1078 newBase = 1;
1079
1080 // call the before functions (if any)
1081 UInt i;
1082 for (i = 0; i < CollectFuncBags.nrBefore; ++i)
1083 CollectFuncBags.before[i]();
1084
1085 MoveBagMemory(GetMembuf(oldBase), GetMembuf(newBase));
1086
1087 // Enable access to new memory
1088 mprotect(GetMembuf(newBase), GetMembufSize(), PROT_READ | PROT_WRITE);
1089 // Block access to old memory (except block 0, which will only occur
1090 // on the first call).
1091 if (oldBase != 0) {
1092 mprotect(GetMembuf(oldBase), GetMembufSize(), PROT_NONE);
1093 }
1094
1095 // call the after functions (if any)
1096 for (i = 0; i < CollectFuncBags.nrAfter; ++i)
1097 CollectFuncBags.after[i]();
1098
1099 oldBase = newBase;
1100 }
1101
1102 #endif
1103
1104 /****************************************************************************
1105 **
1106 *F FinishBags() . . . . . . . . . . . . . . . . . . . . . . .finalize GASMAN
1107 **
1108 ** `FinishBags()' ends GASMAN and returns all memory to the OS pool
1109 **
1110 */
1111
FinishBags(void)1112 void FinishBags( void )
1113 {
1114 SyAllocBags(-(sizeof(Bag)*SizeWorkspace/1024),2);
1115 }
1116
1117 /****************************************************************************
1118 **
1119 *F InitBags(...) . . . . . . . . . . . . . . . . . . . . . initialize Gasman
1120 **
1121 ** 'InitBags' remembers <stack-func>, <stack-bottom>, and <stack-align>
1122 ** in global variables. It also allocates the initial workspace, and sets up
1123 ** the linked list of available masterpointer.
1124 */
1125 static Bag * StackBottomBags;
1126
1127 static UInt StackAlignBags;
1128
1129 static TNumExtraMarkFuncBags ExtraMarkFuncBags;
SetExtraMarkFuncBags(TNumExtraMarkFuncBags func)1130 void SetExtraMarkFuncBags(TNumExtraMarkFuncBags func)
1131 {
1132 ExtraMarkFuncBags = func;
1133 }
1134
1135 GAP_STATIC_ASSERT((sizeof(BagHeader) % sizeof(Bag)) == 0, "BagHeader size must be multiple of word size");
1136
1137
SetStackBottomBags(void * StackBottom)1138 void SetStackBottomBags(void * StackBottom)
1139 {
1140 StackBottomBags = StackBottom;
1141 }
1142
1143
InitBags(UInt initial_size,Bag * stack_bottom,UInt stack_align)1144 void InitBags (
1145 UInt initial_size,
1146 Bag * stack_bottom,
1147 UInt stack_align )
1148 {
1149 Bag * p; /* loop variable */
1150 UInt i; /* loop variable */
1151
1152 ClearGlobalBags();
1153
1154 /* install the allocator and the abort function */
1155 ExtraMarkFuncBags = 0;
1156
1157 // install the stack values
1158 StackBottomBags = stack_bottom;
1159 StackAlignBags = stack_align;
1160
1161 /* first get some storage from the operating system */
1162 initial_size = (initial_size + 511) & ~(511);
1163 MptrBags = SyAllocBags( initial_size, 1 );
1164 GAP_ASSERT(MptrBags);
1165 EndBags = MptrBags + 1024*(initial_size / sizeof(Bag*));
1166
1167 // In GAP_MEM_CHECK we want as few master pointers as possible, as we
1168 // have to loop over them very frequently.
1169 #ifdef GAP_MEM_CHECK
1170 UInt initialBagCount = 100000;
1171 #else
1172 UInt initialBagCount = 1024*initial_size/8/sizeof(Bag*);
1173 #endif
1174 /* 1/8th of the storage goes into the masterpointer area */
1175 FreeMptrBags = (Bag)MptrBags;
1176 for ( p = MptrBags;
1177 p + 2*(SIZE_MPTR_BAGS) <= MptrBags+initialBagCount;
1178 p += SIZE_MPTR_BAGS )
1179 {
1180 *p = (Bag)(p + SIZE_MPTR_BAGS);
1181 }
1182
1183 /* the rest is for bags */
1184 MptrEndBags = MptrBags + initialBagCount;
1185 // Add a small gap between the end of the master pointers and OldBags
1186 // This is mainly here to ensure we do not break allowing OldBags and
1187 // MptrEndBags to differ.
1188 OldBags = MptrEndBags + 10;
1189 YoungBags = OldBags;
1190 AllocBags = OldBags;
1191
1192 AllocSizeBags = 256;
1193
1194 /* install the marking functions */
1195 for ( i = 0; i < NUM_TYPES; i++ )
1196 TabMarkFuncBags[i] = MarkAllSubBagsDefault;
1197
1198 /* Set ChangedBags to a proper initial value */
1199 ChangedBags = 0;
1200
1201 GAP_ASSERT(SanityCheckGasmanPointers());
1202 CANARY_FORBID_ACCESS_ALL_BAGS();
1203 }
1204
1205
1206 /****************************************************************************
1207 **
1208 *F NewBag( <type>, <size> ) . . . . . . . . . . . . . . allocate a new bag
1209 **
1210 ** 'NewBag' is actually quite simple.
1211 **
1212 ** It first tests whether enough storage is available in the allocation area
1213 ** and whether a free masterpointer is available. If not, it starts a
1214 ** garbage collection by calling 'CollectBags' passing <size> as the size of
1215 ** the bag it is currently allocating and 0 to indicate that only a partial
1216 ** garbage collection is called for. If 'CollectBags' fails and returns 0,
1217 ** 'NewBag' also fails and also returns 0.
1218 **
1219 ** Then it takes the first free masterpointer from the linked list of free
1220 ** masterpointers (see "FreeMptrBags").
1221 **
1222 ** Then it writes the size and the type into the word pointed to by
1223 ** 'AllocBags'. Then it writes the identifier, i.e., the location of the
1224 ** masterpointer, into the next word.
1225 **
1226 ** Then it advances 'AllocBags' by '2 + WORDS_BAG(<size>)'.
1227 **
1228 ** Finally it returns the identifier of the new bag.
1229 **
1230 ** All entries of the new bag will be initialized to 0.
1231 **
1232 ** If {\Gasman} was compiled with the option 'COUNT_BAGS' then 'NewBag' also
1233 ** updates the information in 'InfoBags' (see "InfoBags").
1234 **
1235 ** 'NewBag' is implemented as a function instead of a macro for three
1236 ** reasons. It reduces the size of the program, improving the instruction
1237 ** cache hit ratio. The compiler can do anti-aliasing analysis for the
1238 ** local variables of the function. To enable statistics only {\Gasman}
1239 ** needs to be recompiled.
1240 */
NewBag(UInt type,UInt size)1241 Bag NewBag (
1242 UInt type,
1243 UInt size )
1244 {
1245 Bag bag; /* identifier of the new bag */
1246
1247 #ifdef GAP_MEM_CHECK
1248 MaybeMoveBags();
1249 #endif
1250
1251 #ifdef TREMBLE_HEAP
1252 CollectBags(0,0);
1253 #endif
1254
1255 CANARY_DISABLE_VALGRIND();
1256
1257 /* check that a masterpointer and enough storage are available */
1258 if ( (FreeMptrBags == 0 || SizeAllocationArea < WORDS_BAG(sizeof(BagHeader)+size))
1259 && CollectBags( size, 0 ) == 0 )
1260 {
1261 Panic("cannot extend the workspace any more!!!!");
1262 }
1263
1264 GAP_ASSERT(type < T_DUMMY);
1265
1266 #ifdef COUNT_BAGS
1267 /* update the statistics */
1268 NrAllBags += 1;
1269 InfoBags[type].nrLive += 1;
1270 InfoBags[type].nrAll += 1;
1271 InfoBags[type].sizeLive += size;
1272 InfoBags[type].sizeAll += size;
1273 #endif
1274 SizeAllBags += size;
1275
1276 /* get the identifier of the bag and set 'FreeMptrBags' to the next */
1277 bag = FreeMptrBags;
1278 FreeMptrBags = *(Bag*)bag;
1279
1280 /* allocate the storage for the bag */
1281 BagHeader * header = (BagHeader *)AllocBags;
1282 AllocBags = DATA(header) + WORDS_BAG(size);
1283
1284 // enter bag header
1285 header->type = type;
1286 header->flags = 0;
1287 header->size = size;
1288
1289 /* enter link word */
1290 header->link = bag;
1291
1292 /* set the masterpointer */
1293 SET_PTR_BAG(bag, DATA(header));
1294
1295 CANARY_ALLOW_ACCESS_BAG(bag);
1296
1297 GAP_ASSERT(SanityCheckGasmanPointers());
1298
1299 CANARY_ENABLE_VALGRIND();
1300
1301 /* return the identifier of the new bag */
1302 return bag;
1303 }
1304
1305
1306 /****************************************************************************
1307 **
1308 *F RetypeBag(<bag>,<new>) . . . . . . . . . . . . change the type of a bag
1309 **
1310 ** 'RetypeBag' is very simple.
1311 **
1312 ** All it has to do is to change type word of the bag.
1313 **
1314 ** If {\Gasman} was compiled with the option 'COUNT_BAGS' then 'RetypeBag'
1315 ** also updates the information in 'InfoBags' (see "InfoBags").
1316 */
RetypeBag(Bag bag,UInt new_type)1317 void RetypeBag (
1318 Bag bag,
1319 UInt new_type )
1320 {
1321 BagHeader * header = BAG_HEADER(bag);
1322
1323 #ifdef COUNT_BAGS
1324 /* update the statistics */
1325 {
1326 UInt old_type; /* old type of the bag */
1327 UInt size;
1328
1329 old_type = header->type;
1330 size = header->size;
1331 InfoBags[old_type].nrLive -= 1;
1332 InfoBags[new_type].nrLive += 1;
1333 InfoBags[old_type].nrAll -= 1;
1334 InfoBags[new_type].nrAll += 1;
1335 InfoBags[old_type].sizeLive -= size;
1336 InfoBags[new_type].sizeLive += size;
1337 InfoBags[old_type].sizeAll -= size;
1338 InfoBags[new_type].sizeAll += size;
1339 }
1340 #endif
1341
1342 header->type = new_type;
1343 }
1344
1345
1346 /****************************************************************************
1347 **
1348 *F ResizeBag(<bag>,<new>) . . . . . . . . . . . . change the size of a bag
1349 **
1350 ** Basically 'ResizeBag' is rather simple, but there are a few traps that
1351 ** must be avoided.
1352 **
1353 ** If the size of the bag changes only a little bit, so that the number of
1354 ** words needed for the data area does not change, 'ResizeBag' only changes
1355 ** the size word of the bag.
1356 **
1357 ** If the bag is to be shrunk and at least one word becomes free,
1358 ** 'ResizeBag' changes the size word of the bag, and stores a magic
1359 ** size-type word in the first free word. This magic size-type word has
1360 ** type T_DUMMY and the size is the number of following free bytes, which is
1361 ** always divisible by 'sizeof(Bag)'. The type T_DUMMY allows 'CollectBags'
1362 ** to detect that this body is the remainder of a resize operation, and the
1363 ** size allows it to know how many bytes there are in this body (see
1364 ** "Implementation of CollectBags").
1365 **
1366 ** So for example if 'ResizeBag' shrinks a bag of type 7 from 18 bytes to 10
1367 ** bytes the situation before 'ResizeBag' is as follows{\:}
1368 **
1369 ** +---------+
1370 ** |<masterp>|
1371 ** +---------+
1372 ** \_____________
1373 ** \
1374 ** V
1375 ** +---------+---------+--------------------------------------------+----+
1376 ** | 18 . 7 | <link> | . . . . | pad|
1377 ** +---------+---------+--------------------------------------------+----+
1378 **
1379 ** And after 'ResizeBag' the situation is as follows{\:}
1380 **
1381 ** +---------+
1382 ** |<masterp>|
1383 ** +---------+
1384 ** \_____________
1385 ** \
1386 ** V
1387 ** +---------+---------+------------------------+----+-------------+-----+
1388 ** | 10 . 7 | <link> | . . | pad| 4 . T_DUMMY | |
1389 ** +---------+---------+------------------------+----+-------------+-----+
1390 **
1391 ** If the bag is to be extended and it is that last allocated bag, so that
1392 ** it is immediately adjacent to the allocation area, 'ResizeBag' simply
1393 ** increments 'AllocBags' after making sure that enough space is available
1394 ** in the allocation area (see "Layout of the Workspace").
1395 **
1396 ** If the bag is to be extended and it is not the last allocated bag,
1397 ** 'ResizeBag' first allocates a new bag similar to 'NewBag', but without
1398 ** using a new masterpointer. Then it copies the old contents to the new
1399 ** bag. Finally it resets the masterpointer of the bag to point to the new
1400 ** address. Then it changes the type of the old body to T_DUMMY, so that the
1401 ** garbage collection can detect that this body is the remainder of a resize
1402 ** (see "Implementation of NewBag" and "Implementation of CollectBags").
1403 **
1404 ** When an old bag is extended, it will now reside in the young bags area,
1405 ** and thus appear to be young. Since old bags are supposed to survive
1406 ** partial garbage collections 'ResizeBag' must somehow protect this bag
1407 ** from partial garbage collections. This is done by putting this bag onto
1408 ** the linked list of changed bags (see "ChangedBags"). When a partial
1409 ** garbage collection sees a young bag on the list of changed bags, it knows
1410 ** that it is the result of 'ResizeBag' of an old bag, and does not throw it
1411 ** away (see "Implementation of CollectBags"). Note that when 'ResizeBag'
1412 ** tries this, the bag may already be on the linked list, either because it
1413 ** has been resized earlier, or because it has been changed. In this case
1414 ** 'ResizeBag' simply keeps the bag on this linked list.
1415 **
1416 ** If {\Gasman} was compiled with the option 'COUNT_BAGS' then 'ResizeBag'
1417 ** also updates the information in 'InfoBags' (see "InfoBags").
1418 */
ResizeBag(Bag bag,UInt new_size)1419 UInt ResizeBag (
1420 Bag bag,
1421 UInt new_size )
1422 {
1423
1424 #ifdef GAP_MEM_CHECK
1425 MaybeMoveBags();
1426 #endif
1427
1428 #ifdef TREMBLE_HEAP
1429 CollectBags(0,0);
1430 #endif
1431
1432 CANARY_DISABLE_VALGRIND();
1433
1434 CANARY_FORBID_ACCESS_BAG(bag);
1435
1436 BagHeader * header = BAG_HEADER(bag);
1437 UInt type = header->type;
1438 UInt flags = header->flags;
1439 UInt old_size = header->size;
1440
1441 #ifdef COUNT_BAGS
1442 /* update the statistics */
1443 InfoBags[type].sizeLive += new_size - old_size;
1444 #endif
1445
1446 const Int diff = WORDS_BAG(new_size) - WORDS_BAG(old_size);
1447
1448 // if the real size of the bag doesn't change, not much needs to be done
1449 if ( diff == 0 ) {
1450
1451 header->size = new_size;
1452 }
1453
1454 // if the bag is shrunk we insert a magic marker into the heap
1455 // Note: if the bag is the last bag, we could in theory also shrink it
1456 // by moving 'AllocBags', however this is not correct as the "freed"
1457 // memory may not be zero filled, and zeroing it out would cost us
1458 else if ( diff < 0 ) {
1459
1460 // leave magic size-type word for the sweeper, type must be T_DUMMY
1461 BagHeader * freeHeader = (BagHeader *)(DATA(header) + WORDS_BAG(new_size));
1462 freeHeader->type = T_DUMMY;
1463 if ( diff == -1 ) {
1464 // if there is only one free word, avoid setting the size in
1465 // the header: there is no space for it on 32bit systems;
1466 // instead set flags to 1 to inform the sweeper.
1467 freeHeader->flags = 1;
1468 }
1469 else {
1470 freeHeader->flags = 0;
1471 freeHeader->size = (-diff-1)*sizeof(Bag);
1472 }
1473
1474 header->size = new_size;
1475 }
1476
1477 // if the last bag is enlarged ...
1478 else if (CONST_PTR_BAG(bag) + WORDS_BAG(old_size) == AllocBags) {
1479 // check that enough storage for the new bag is available
1480 if (SpaceBetweenPointers(EndBags, CONST_PTR_BAG(bag)) < WORDS_BAG(new_size)
1481 && CollectBags( new_size-old_size, 0 ) == 0 ) {
1482 Panic("cannot extend the workspace any more!!!!!");
1483 }
1484
1485 // update header pointer in case bag moved
1486 header = BAG_HEADER(bag);
1487
1488 // simply increase the free pointer
1489 if ( YoungBags == AllocBags )
1490 YoungBags += diff;
1491 AllocBags += diff;
1492
1493 // and increase the total amount allocated by the difference
1494 #ifdef COUNT_BAGS
1495 InfoBags[type].sizeAll += new_size - old_size;
1496 #endif
1497 SizeAllBags += new_size - old_size;
1498
1499 header->size = new_size;
1500 }
1501
1502 // if the bag is enlarged ...
1503 else {
1504
1505 /* check that enough storage for the new bag is available */
1506 if ( SizeAllocationArea < WORDS_BAG(sizeof(BagHeader)+new_size)
1507 && CollectBags( new_size, 0 ) == 0 ) {
1508 Panic("Cannot extend the workspace any more!!!!!!");
1509 }
1510
1511 // update header pointer in case bag moved
1512 header = BAG_HEADER(bag);
1513
1514 // leave magic size-type word for the sweeper, type must be T_DUMMY
1515 header->type = T_DUMMY;
1516 header->flags = 0;
1517 header->size =
1518 sizeof(BagHeader) + (TIGHT_WORDS_BAG(old_size) - 1) * sizeof(Bag);
1519
1520 /* allocate the storage for the bag */
1521 BagHeader * newHeader = (BagHeader *)AllocBags;
1522 AllocBags = DATA(newHeader) + WORDS_BAG(new_size);
1523
1524 newHeader->type = type;
1525 newHeader->flags = flags;
1526 newHeader->size = new_size;
1527
1528
1529 #ifdef COUNT_BAGS
1530 InfoBags[type].sizeAll += new_size;
1531 #endif
1532 SizeAllBags += new_size;
1533
1534
1535 CANARY_DISABLE_VALGRIND();
1536 /* if the bag is already on the changed bags list, keep it there */
1537 if ( header->link != bag ) {
1538 newHeader->link = header->link;
1539 }
1540
1541 /* if the bag is old, put it onto the changed bags list */
1542 else if (CONST_PTR_BAG(bag) <= YoungBags) {
1543 newHeader->link = ChangedBags;
1544 ChangedBags = bag;
1545 }
1546
1547 /* if the bag is young, enter the normal link word */
1548 else {
1549 newHeader->link = bag;
1550 }
1551 CANARY_ENABLE_VALGRIND();
1552
1553 /* set the masterpointer */
1554 Bag * dst = DATA(newHeader);
1555 SET_PTR_BAG(bag, dst);
1556
1557 /* copy the contents of the bag */
1558 SyMemmove((void *)dst, (void *)DATA(header),
1559 sizeof(Obj) * WORDS_BAG(old_size));
1560 }
1561
1562 GAP_ASSERT(SanityCheckGasmanPointers());
1563 CANARY_ALLOW_ACCESS_BAG(bag);
1564 CANARY_ENABLE_VALGRIND();
1565 /* return success */
1566 return 1;
1567 }
1568
1569
1570 /****************************************************************************
1571 **
1572 *F CollectBags( <size>, <full> ) . . . . . . . . . . . . . collect dead bags
1573 **
1574 ** 'CollectBags' is the function that does most of the work of {\Gasman}.
1575 **
1576 ** A partial garbage collection where every bag is young is clearly a full
1577 ** garbage collection. So to perform a full garbage collection,
1578 ** 'CollectBags' first sets 'YoungBags' to 'OldBags', making every bag
1579 ** young, and empties the list of changed old bags, since there are no old
1580 ** bags anymore, there can be no changed old bags anymore. So from now on
1581 ** we can assume that 'CollectBags' is doing a partial garbage
1582 ** collection. In addition, the values 'NewWeakDeadBagMarker' and
1583 ** 'OldWeakDeadBagMarker' are exchanged, so that bag identifiers that have
1584 ** been halfdead since before this full garbage collection can be
1585 ** distinguished from those which have died on this pass.
1586 **
1587 ** Garbage collection is performed in three phases. The mark phase, the
1588 ** sweep phase, and the check phase.
1589 **
1590 ** In the *mark phase*, 'CollectBags' finds all young bags that are still
1591 ** live and builds a linked list of those bags (see "MarkedBags"). A bag is
1592 ** put on this list of marked bags by applying 'MarkBag' to its
1593 ** identifier. Note that 'MarkBag' checks that a bag is not already on the
1594 ** list of marked bags, before it puts it on the list, so no bag can be put
1595 ** twice on this list.
1596 **
1597 ** First, 'CollectBags' marks all young bags that are directly accessible
1598 ** through global variables, i.e., it marks those young bags whose
1599 ** identifiers appear in global variables. It does this by applying
1600 ** 'MarkBag' to the values at the addresses of global variables that may
1601 ** hold bag identifiers provided by 'InitGlobalBag' (see "InitGlobalBag").
1602 **
1603 ** Next, 'CollectBags' marks all young bags that are directly accessible
1604 ** through local variables, i.e., it marks those young bags whose
1605 ** identifiers appear in the stack. It does this by calling the stack
1606 ** marking function <stack-func> (see "InitBags"). The generic stack
1607 ** marking function, which is called if <stack-func> (see "InitBags") was 0,
1608 ** is described below. The problem is that there is usually not sufficient
1609 ** information available to decide if a value on the stack is really the
1610 ** identifier of a bag, or is a value of another type that only appears to
1611 ** be the identifier of a bag. The position usually taken by the stack
1612 ** marking function is that everything on the stack that could possibly be
1613 ** interpreted as the identifier of a bag is an identifier of a bag, and
1614 ** that this bag is therefore live. This position is what makes {\Gasman} a
1615 ** conservative storage manager.
1616 **
1617 ** The generic stack marking function 'GenStackFuncBags', which is called if
1618 ** <stack-func> (see "InitBags") was 0, works by applying 'MarkBag' to all
1619 ** the values on the stack, which is supposed to extend from <stack-start>
1620 ** (see "InitBags") to the address of a local variable of the function.
1621 ** Note that some local variables may not be stored on the stack, because
1622 ** they are still in the processors registers. 'GenStackFuncBags' uses a
1623 ** jump buffer 'RegsBags', filled by the C library function 'setjmp', marking
1624 ** all bags whose identifiers appear in 'RegsBags'. This is a dirty hack,
1625 ** that need not work, but actually works on a surprisingly large number of
1626 ** machines. But it will not work on Sun Sparc machines, which have larger
1627 ** register files, of which only the part visible to the current function
1628 ** will be saved by 'setjmp'. For those machines 'GenStackFuncBags' first
1629 ** calls the operating system to flush the whole register file. Note that a
1630 ** compiler may save a register somewhere else if it wants to use this
1631 ** register for something else. Usually this register is saved further up
1632 ** the stack, i.e., beyond the address of the local variable, and
1633 ** 'GenStackFuncBags' would not see this value any more. To deal with this
1634 ** problem, 'setjmp' must be called *before* 'GenStackFuncBags' is entered,
1635 ** i.e., before the registers may have been saved elsewhere. Thus it is
1636 ** called from 'CollectBags'.
1637 **
1638 ** Next 'CollectBags' marks all young bags that are directly accessible from
1639 ** old bags, i.e., it marks all young bags whose identifiers appear in the
1640 ** data areas of old bags. It does this by applying 'MarkBag' to each
1641 ** identifier appearing in changed old bags, i.e., in those bags that appear
1642 ** on the list of changed old bags (see "ChangedBags"). To be more precise
1643 ** it calls the marking function for the appropriate type to each changed
1644 ** old bag (see "InitMarkFuncBags"). It need not apply the marking function
1645 ** to each old bag, because old bags that have not been changed since the
1646 ** last garbage collection cannot contain identifiers of young bags, which
1647 ** have been allocated since the last garbage collection. Of course marking
1648 ** the subbags of only the changed old bags is more efficient than marking
1649 ** the subbags of all old bags only if the number of changed old bags is
1650 ** smaller than the total number of old bags, but this is a very reasonable
1651 ** assumption.
1652 **
1653 ** Note that there may also be bags that appear to be young on the list of
1654 ** changed old bags. Those bags are old bags that were extended since the
1655 ** last garbage collection and therefore have their body in the young bags
1656 ** area (see "Implementation of ResizeBag"). When 'CollectBags' finds such
1657 ** a bag on the list of changed old bags it applies 'MarkBag' to its
1658 ** identifier and thereby ensures that this bag will not be thrown away by
1659 ** this garbage collection.
1660 **
1661 ** Next, 'CollectBags' marks all young bags that are *indirectly*
1662 ** accessible, i.e., it marks the subbags of the already marked bags, their
1663 ** subbags and so on. It does so by walking along the list of already
1664 ** marked bags and applies the marking function of the appropriate type to
1665 ** each bag on this list (see "InitMarkFuncBags"). Those marking functions
1666 ** then apply 'MarkBag' or 'MarkBagWeakly' to each identifier appearing in
1667 ** the bag.
1668 **
1669 ** After the marking function has been applied to a bag on the list of
1670 ** marked bag, this bag is removed from the list. Thus the marking phase is
1671 ** over when the list of marked bags has become empty. Removing the bag
1672 ** from the list of marked bags must be done at this time, because newly
1673 ** marked bags are *prepended* to the list of marked bags. This is done to
1674 ** ensure that bags are marked in a depth first order, which should usually
1675 ** improve locality of reference. When a bag is taken from the list of
1676 ** marked bags it is *tagged*. This tag serves two purposes. A bag that is
1677 ** tagged is not put on the list of marked bags when 'MarkBag' is applied
1678 ** to its identifier. This ensures that no bag is put more than once onto
1679 ** the list of marked bags, otherwise endless marking loops could happen for
1680 ** structures that contain circular references. Also the sweep phase later
1681 ** uses the presence of the tag to decide the status of the bag. There are
1682 ** three possible statuses: LIVE, DEAD and HALFDEAD. The default state of a
1683 ** bag with its identifier in the link word, is the tag for DEAD. Live bags
1684 ** are tagged with MARKED_ALIVE(<identifier>) in the link word, and
1685 ** half-dead bags (ie bags pointed to weakly but not strongly) with the tage
1686 ** MARKED_HALFDEAD(<identifier>).
1687 **
1688 ** Note that 'CollectBags' cannot put a random or magic value into the link
1689 ** word, because the sweep phase must be able to find the masterpointer of a
1690 ** bag by only looking at the link word of a bag. This is done using the macros
1691 ** UNMARKED_XXX(<link word contents>).
1692 **
1693 ** In the *sweep phase*, 'CollectBags' deallocates all dead bags and
1694 ** compacts the live bags at the beginning of the workspace.
1695 **
1696 ** In this phase 'CollectBags' uses a destination pointer 'dst', which
1697 ** points to the address a body will be copied to, and a source pointer
1698 ** 'src', which points to the address a body currently has. Both pointers
1699 ** initially point to the beginning of the young bags area. Then
1700 ** 'CollectBags' looks at the body pointed to by the source pointer.
1701 **
1702 ** If this body has type T_DUMMY, it is the remainder of a resize operation.
1703 ** In this case 'CollectBags' simply moves the source pointer to the next
1704 ** body (see "Implementation of ResizeBag").
1705 **
1706 **
1707 ** Otherwise, if the link word contains the identifier of the bag itself,
1708
1709 ** marked dead, 'CollectBags' first adds the masterpointer to the list of
1710 ** available masterpointers (see "FreeMptrBags") and then simply moves the
1711 ** source pointer to the next bag.
1712 **
1713 ** Otherwise, if the link word contains the identifier of the bag marked
1714 ** alive, this bag is still live. In this case 'CollectBags' calls the
1715 ** sweeping function for this bag, if one is installed, or otherwise copies
1716 ** the body from the source address to the destination address, stores the
1717 ** address of the masterpointer without the tag in the link word, and
1718 ** updates the masterpointer to point to the new address of the data area of
1719 ** the bag. After the copying the source pointer points to the next bag,
1720 ** and the destination pointer points just past the copy.
1721 **
1722 ** Finally, if the link word contains the identifier of the bag marked half
1723 ** dead, then 'CollectBags' puts the special value 'NewWeakDeadBagMarker'
1724 ** into the masterpointer corresponding to the bag, to signify that this bag
1725 ** has been collected as garbage.
1726 **
1727 ** This is repeated until the source pointer reaches the end of the young
1728 ** bags area, i.e., reaches 'AllocBags'.
1729 **
1730 ** The new free storage now is the area between the destination pointer and
1731 ** the source pointer. If the initialization flag <dirty> (see "InitBags")
1732 ** was 0, this area is now cleared.
1733 **
1734 ** Next, 'CollectBags' sets 'YoungBags' and 'AllocBags' to the address
1735 ** pointed to by the destination pointer. So all the young bags that have
1736 ** survived this garbage collection are now promoted to be old bags, and
1737 ** allocation of new bags will start at the beginning of the free storage.
1738 **
1739 ** Finally, the *check phase* checks whether the garbage collection freed
1740 ** enough storage and masterpointers.
1741 **
1742 ** After a partial garbage collection, 'CollectBags' wants at least '<size>
1743 ** + AllocSizeBags' bytes of free storage available, where <size> is the
1744 ** size of the bag that 'NewBag' is currently trying to allocate. Also the
1745 ** number of free masterpointers should be larger than the number of bags
1746 ** allocated since the previous garbage collection plus 4096 more to be
1747 ** safe. If less free storage or fewer masterpointers are available,
1748 ** 'CollectBags' calls itself for a full garbage collection.
1749 **
1750 ** After a full garbage collection, 'CollectBags' wants at least <size>
1751 ** bytes of free storage available, where <size> is the size of the bag that
1752 ** 'NewBag' is currently trying to allocate. Also it wants at least one
1753 ** free masterpointer. If less free storage or no masterpointer are
1754 ** available, 'CollectBags' tries to extend the workspace using the
1755 ** allocation function <alloc-func> (see "InitBags"). If <alloc-func>
1756 ** refuses to extend the workspace, 'CollectBags' returns 0 to indicate
1757 ** failure to 'NewBag'. In any case 'CollectBags' will try to extend the
1758 ** workspace so that at least one eigth of the storage is free, that is, one
1759 ** eight of the storage between 'OldBags' and 'EndBags' shall be free. If
1760 ** <alloc-func> refuses this extension of the workspace, 'CollectBags' tries
1761 ** to get along with what it got. Also 'CollectBags' wants at least one
1762 ** masterpointer per 8 words of free storage available. If this is not the
1763 ** case, 'CollectBags' extends the masterpointer area by moving the bodies
1764 ** of all bags and readjusting the masterpointers.
1765 **
1766 ** Also, after a full garbage collection, 'CollectBags' scans the
1767 ** masterpointer area for identifiers containing 'OldWeakDeadBagMarker'. If
1768 ** the sweep functions have done their work then no references to these bag
1769 ** identifiers can exist, and so 'CollectBags' frees these masterpointers.
1770 */
1771
1772 static syJmp_buf RegsBags;
1773
1774 #if defined(SPARC)
SparcStackFuncBags(void)1775 static void SparcStackFuncBags(void)
1776 {
1777 asm (" ta 0x3 ");
1778 asm (" mov %sp,%o0" );
1779 }
1780 #endif
1781
1782
GenStackFuncBags(void)1783 static void GenStackFuncBags(void)
1784 {
1785 Bag * top; /* top of stack */
1786 Bag * p; /* loop variable */
1787 UInt i; /* loop variable */
1788
1789 #ifdef DEBUG_GASMAN_MARKING
1790 DisableMarkBagValidation = 1;
1791 #endif
1792
1793 top = (Bag*)((void*)&top);
1794 if ( StackBottomBags < top ) {
1795 for ( i = 0; i < sizeof(Bag*); i += StackAlignBags ) {
1796 for (p = (Bag *)((char *)StackBottomBags + i); p < top; p++) {
1797 Bag * pcpy = p;
1798 #if defined(GAP_MEMORY_CANARY)
1799 // Need to mark this pointer as readable for valgrind
1800 VALGRIND_MAKE_MEM_DEFINED(&pcpy, sizeof(pcpy));
1801 #endif
1802 MarkBag(*pcpy);
1803 }
1804 }
1805 }
1806 else {
1807 for ( i = 0; i < sizeof(Bag*); i += StackAlignBags ) {
1808 for (p = (Bag *)((char *)StackBottomBags - i); top < p; p--) {
1809 Bag * pcpy = p;
1810 #if defined(GAP_MEMORY_CANARY)
1811 // Need to mark this pointer as readable for valgrind
1812 VALGRIND_MAKE_MEM_DEFINED(&pcpy, sizeof(pcpy));
1813 #endif
1814 MarkBag(*pcpy);
1815 }
1816 }
1817 }
1818
1819 /* mark from registers, dirty dirty hack */
1820 for ( p = (Bag*)((void*)RegsBags);
1821 p < (Bag*)((void*)RegsBags)+sizeof(RegsBags)/sizeof(Bag);
1822 p++ )
1823 MarkBag( *p );
1824
1825 #ifdef DEBUG_GASMAN_MARKING
1826 DisableMarkBagValidation = 0;
1827 #endif
1828 }
1829
1830 static UInt FullBags;
1831
1832 /* These are used to overwrite masterpointers which may still be
1833 linked from weak pointer objects but whose bag bodies have been
1834 collected. Two values are used so that old masterpointers of this
1835 kind can be reclaimed after a full garbage collection. The values must
1836 not look like valid pointers, and should be congruent to 1 mod sizeof(Bag),
1837 to ensure that IsWeakDeadBag works correctly.
1838 */
1839
1840 static Bag * NewWeakDeadBagMarker = (Bag *)(1000*sizeof(Bag) + 1L);
1841 static Bag * OldWeakDeadBagMarker = (Bag *)(1001*sizeof(Bag) + 1L);
1842
1843
1844
CollectBags(UInt size,UInt full)1845 UInt CollectBags (
1846 UInt size,
1847 UInt full )
1848 {
1849 Bag first; /* first bag on a linked list */
1850 Bag * p; /* loop variable */
1851 Bag * dst; /* destination in sweeping */
1852 Bag * src; /* source in sweeping */
1853 Bag * end; /* end of a bag in sweeping */
1854 UInt nrLiveBags; /* number of live new bags */
1855 UInt sizeLiveBags; /* total size of live new bags */
1856 UInt nrDeadBags; /* number of dead new bags */
1857 UInt nrHalfDeadBags; /* number of dead new bags */
1858 UInt sizeDeadBags; /* total size of dead new bags */
1859 UInt done; /* do we have to make a full gc */
1860 UInt i; /* loop variable */
1861
1862 GAP_ASSERT(SanityCheckGasmanPointers());
1863 CANARY_DISABLE_VALGRIND();
1864 CANARY_FORBID_ACCESS_ALL_BAGS();
1865 #ifdef DEBUG_MASTERPOINTERS
1866 CheckMasterPointers();
1867 #endif
1868
1869
1870 // call the before functions (if any)
1871 for (i = 0; i < CollectFuncBags.nrBefore; ++i)
1872 CollectFuncBags.before[i]();
1873
1874 /* copy 'full' into a global variable, to avoid warning from GNU C */
1875 FullBags = full;
1876
1877 /* do we want to make a full garbage collection? */
1878 again:
1879 if ( FullBags ) {
1880
1881 /* then every bag is considered to be a young bag */
1882 YoungBags = OldBags;
1883 NrLiveBags = 0;
1884 SizeLiveBags = 0;
1885
1886 /* empty the list of changed old bags */
1887 while ( ChangedBags != 0 ) {
1888 first = ChangedBags;
1889 ChangedBags = LINK_BAG(first);
1890 LINK_BAG(first) = first;
1891 }
1892
1893 // Also time to change the tag for dead children of weak pointer
1894 // objects. After this collection, there can be no more weak pointer
1895 // objects pointing to anything with OldWeakDeadBagMarker in it.
1896 SWAP(Bag *, OldWeakDeadBagMarker, NewWeakDeadBagMarker);
1897 }
1898
1899 /* information at the beginning of garbage collections */
1900 SyMsgsBags(FullBags, 0, 0);
1901
1902 /* * * * * * * * * * * * * * * mark phase * * * * * * * * * * * * * * */
1903
1904 /* prepare the list of marked bags for the future */
1905 MarkedBags = 0;
1906
1907 /* mark from the static area */
1908 for ( i = 0; i < GlobalBags.nr; i++ )
1909 MarkBag( *GlobalBags.addr[i] );
1910
1911 /* allow installing a custom marking function. This is used for integrating
1912 GAP (possibly linked as a shared library) with other code bases which use
1913 their own form of garbage collection. For example, with Python (for
1914 SageMath) or Julia. */
1915 if (ExtraMarkFuncBags) {
1916 (*ExtraMarkFuncBags)();
1917 }
1918
1919 /* mark from the stack */
1920 sySetjmp( RegsBags );
1921 #if defined(SPARC)
1922 SparcStackFuncBags();
1923 #endif
1924 GenStackFuncBags();
1925
1926 /* mark the subbags of the changed old bags */
1927 while ( ChangedBags != 0 ) {
1928 // extract the head from the linked list
1929 first = ChangedBags;
1930 ChangedBags = LINK_BAG(first);
1931 LINK_BAG(first) = first;
1932
1933 // mark subbags - we need to distinguish between young and old bags:
1934 // For old bags, we invoke the marking function for bags with the
1935 // given TNUM.
1936 // Young bags normally are never put onto the changed list, because
1937 // CHANGED_BAGS ignores young bags. However, it can happen if we
1938 // resize an old bag and it needs to be moved as a result, or if we
1939 // swap the masterpointers of an old and a young bag. In that case,
1940 // we must be careful to not collect the young bag (which was old
1941 // before the masterpointer swap; see the comment on
1942 // 'SwapMasterPoint' for a detailed explanation why that is so). To
1943 // facilitate this, 'SwapMasterPoint' forces that bag onto the
1944 // ChangedBags list. Then, we put such a young bag onto the list of
1945 // marked bags (via MarkBag), which ensures it is not collected.
1946 //
1947 // Note that it doesn't help to use 'MarkBag' on an old bags, as it
1948 // ignores old bags (which are always assumed to be marked).
1949 // Conversely, using TabMarkFuncBags on a young bag is no good,
1950 // because that function only puts subbags on the list of marked
1951 // bag, which does not prevent the young bag itself from being
1952 // collected (which is what we need).
1953 if (CONST_PTR_BAG(first) <= YoungBags)
1954 (*TabMarkFuncBags[TNUM_BAG(first)])( first );
1955 else
1956 MarkBag(first);
1957 }
1958
1959
1960 /* tag all marked bags and mark their subbags */
1961 nrLiveBags = 0;
1962 sizeLiveBags = 0;
1963 while ( MarkedBags != 0 ) {
1964 // extract the head from the linked list
1965 first = MarkedBags;
1966 MarkedBags = LINK_BAG(first);
1967 // Gasman in some places treats as bag where
1968 // CONST_PTR_BAG(bag) == YoungBags as a young bag, and in other
1969 // places as an old bag. However, this is not a problem because
1970 // it is not possible for such a bag to exist. Sanity check
1971 // this condition.
1972 GAP_ASSERT(CONST_PTR_BAG(first) != YoungBags);
1973
1974 if (CONST_PTR_BAG(first) > YoungBags) {
1975 LINK_BAG(first) = MARKED_ALIVE(first);
1976 }
1977 else {
1978 LINK_BAG(first) = first;
1979 }
1980
1981 // mark subbags
1982 (*TabMarkFuncBags[TNUM_BAG(first)])( first );
1983
1984 // collect some statistics
1985 nrLiveBags++;
1986 sizeLiveBags += SIZE_BAG(first);
1987 }
1988
1989 /* information after the mark phase */
1990 NrLiveBags += nrLiveBags;
1991 SyMsgsBags(FullBags, 1, nrLiveBags);
1992 SizeLiveBags += sizeLiveBags;
1993 SyMsgsBags(FullBags, 2, sizeLiveBags / 1024);
1994
1995 /* * * * * * * * * * * * * * * sweep phase * * * * * * * * * * * * * * */
1996
1997 /* sweep through the young generation */
1998 nrDeadBags = 0;
1999 nrHalfDeadBags = 0;
2000 sizeDeadBags = 0;
2001 dst = YoungBags;
2002 src = YoungBags;
2003 while ( src < AllocBags ) {
2004 BagHeader * header = (BagHeader *)src;
2005
2006 /* leftover of a resize of <n> bytes */
2007 if ( header->type == T_DUMMY ) {
2008
2009 /* advance src */
2010 if (header->flags == 1)
2011 src++;
2012 else
2013 src += 1 + WORDS_BAG(header->size);
2014
2015 }
2016
2017 /* dead bag */
2018 else if (GET_MARK_BITS(header->link) == DEAD) {
2019 #ifdef DEBUG_MASTERPOINTERS
2020 if (CONST_PTR_BAG(UNMARKED_DEAD(header->link)) != DATA(header)) {
2021 Panic("incorrectly marked DEAD bag");
2022 }
2023 #endif
2024
2025
2026 /* call freeing function */
2027 if (TabFreeFuncBags[ header->type ] != 0) {
2028 (*TabFreeFuncBags[ header->type ])( header->link );
2029 }
2030
2031 /* update count */
2032 nrDeadBags += 1;
2033 sizeDeadBags += header->size;
2034
2035 #ifdef COUNT_BAGS
2036 /* update the statistics */
2037 InfoBags[header->type].nrLive -= 1;
2038 InfoBags[header->type].sizeLive -= header->size;
2039 #endif
2040
2041 /* free the identifier */
2042 *(Bag*)(header->link) = FreeMptrBags;
2043 FreeMptrBags = header->link;
2044
2045 /* advance src */
2046 src = DATA(header) + WORDS_BAG( header->size ) ;
2047
2048 }
2049
2050 /* half-dead bag */
2051 else if (GET_MARK_BITS(header->link) == HALFDEAD) {
2052 #ifdef DEBUG_MASTERPOINTERS
2053 if (CONST_PTR_BAG(UNMARKED_HALFDEAD(header->link)) != DATA(header)) {
2054 Panic("incorrectly marked HALFDEAD bag");
2055 }
2056 #endif
2057
2058 /* update count */
2059 nrDeadBags += 1;
2060 sizeDeadBags += header->size;
2061
2062 #ifdef COUNT_BAGS
2063 /* update the statistics */
2064 InfoBags[header->type].nrLive -= 1;
2065 InfoBags[header->type].sizeLive -= header->size;
2066 #endif
2067
2068 /* don't free the identifier */
2069 if (((UInt)UNMARKED_HALFDEAD(header->link)) % 4 != 0)
2070 Panic("align error in halfdead bag");
2071
2072 *(Bag**)(UNMARKED_HALFDEAD(header->link)) = NewWeakDeadBagMarker;
2073 nrHalfDeadBags ++;
2074
2075 /* advance src */
2076 src = DATA(header) + WORDS_BAG( header->size );
2077
2078 }
2079
2080 /* live bag */
2081 else if (GET_MARK_BITS(header->link) == ALIVE) {
2082 #ifdef DEBUG_MASTERPOINTERS
2083 if (CONST_PTR_BAG(UNMARKED_ALIVE(header->link)) != DATA(header)) {
2084 Panic("incorrectly marked ALIVE bag");
2085 }
2086 #endif
2087
2088 BagHeader * dstHeader = (BagHeader *)dst;
2089
2090 // update identifier, copy bag header
2091 SET_PTR_BAG( UNMARKED_ALIVE(header->link), DATA(dstHeader));
2092 end = DATA(header) + WORDS_BAG( header->size );
2093 dstHeader->type = header->type;
2094 dstHeader->flags = header->flags;
2095 dstHeader->size = header->size;
2096
2097 dstHeader->link = (Bag)UNMARKED_ALIVE(header->link);
2098 dst = DATA(dstHeader);
2099
2100 /* copy data area */
2101 if (TabSweepFuncBags[header->type] != 0) {
2102 /* Call the installed sweeping function */
2103 (*(TabSweepFuncBags[header->type]))(DATA(header), dst, end - DATA(header));
2104 dst += end - DATA(header);
2105 }
2106
2107 /* Otherwise do the default thing */
2108 else if ( dst != DATA(header) ) {
2109 SyMemmove(dst, DATA(header), (end - DATA(header))*sizeof(Bag));
2110 dst += end - DATA(header);
2111 }
2112 else {
2113 dst = end;
2114 }
2115 src = end;
2116 }
2117
2118 /* oops */
2119 else {
2120 Panic("Gasman found a bogus header");
2121 }
2122
2123 }
2124
2125 /* reset the pointer to the free storage */
2126 AllocBags = YoungBags = dst;
2127
2128 /* clear the new free area */
2129 memset(dst, 0, ((Char *)src)-((Char *)dst));
2130
2131 /* information after the sweep phase */
2132 NrDeadBags += nrDeadBags;
2133 NrHalfDeadBags += nrHalfDeadBags;
2134 SyMsgsBags(FullBags, 3, (FullBags ? NrDeadBags : nrDeadBags));
2135 if ( FullBags )
2136 NrDeadBags = 0;
2137 SizeDeadBags += sizeDeadBags;
2138 SyMsgsBags(FullBags, 4, (FullBags ? SizeDeadBags : sizeDeadBags) / 1024);
2139 if ( FullBags )
2140 SizeDeadBags = 0;
2141
2142 /* * * * * * * * * * * * * * * check phase * * * * * * * * * * * * * * */
2143
2144 // Check if this allocation would even fit into memory
2145 if (SIZE_MAX - (size_t)(sizeof(BagHeader) + size) < (size_t)AllocBags) {
2146 return 0;
2147 }
2148
2149 // store in 'stopBags' where this allocation takes us
2150 Bag * stopBags = AllocBags + WORDS_BAG(sizeof(BagHeader)+size);
2151
2152
2153 /* if we only performed a partial garbage collection */
2154 if ( ! FullBags ) {
2155
2156 /* maybe adjust the size of the allocation area */
2157 if ( nrLiveBags+nrDeadBags +nrHalfDeadBags < 512
2158
2159 /* The test below should stop AllocSizeBags
2160 growing uncontrollably when all bags are big */
2161 && stopBags > OldBags + 4*1024*WORDS_BAG(AllocSizeBags))
2162 AllocSizeBags += 256;
2163 else if ( 4096 < nrLiveBags+nrDeadBags+nrHalfDeadBags
2164 && 256 < AllocSizeBags )
2165 AllocSizeBags -= 256;
2166
2167 /* if we don't get enough free storage or masterpointers do full gc */
2168 if ( EndBags < stopBags + WORDS_BAG(1024*AllocSizeBags)
2169 || SizeMptrsArea <
2170
2171 /* nrLiveBags+nrDeadBags+nrHalfDeadBags+ 4096 */
2172 /* If this test triggered, but the one below didn't
2173 then a full collection would ensue which wouldn't
2174 do anything useful. Possibly a version of the
2175 above test should be moved into the full collection also
2176 but I wasn't sure it always made sense SL */
2177
2178 /* change the test to avoid subtracting unsigned integers */
2179
2180 WORDS_BAG(AllocSizeBags*1024)/7 +(NrLiveBags + NrHalfDeadBags)
2181 ) {
2182 done = 0;
2183 }
2184 else {
2185 done = 1;
2186 }
2187
2188 }
2189
2190 /* if we already performed a full garbage collection */
2191 else {
2192
2193 /* Clean up old half-dead bags
2194 also reorder the free masterpointer linked list
2195 to get more locality */
2196 FreeMptrBags = (Bag)0L;
2197 for (p = MptrBags; p < MptrEndBags; p+= SIZE_MPTR_BAGS)
2198 {
2199 Bag *mptr = (Bag *)*p;
2200 if ( mptr == OldWeakDeadBagMarker)
2201 NrHalfDeadBags--;
2202 if (mptr == OldWeakDeadBagMarker || IS_BAG_ID(mptr) || mptr == 0) {
2203 *p = FreeMptrBags;
2204 FreeMptrBags = (Bag)p;
2205 }
2206 }
2207
2208
2209 /* get the storage we absolutely need */
2210 while ( EndBags < stopBags
2211 && SyAllocBags(512,1) )
2212 EndBags += WORDS_BAG(512*1024L);
2213
2214 /* if not enough storage is free, fail */
2215 if ( EndBags < stopBags )
2216 return 0;
2217
2218 /* if less than 1/8th is free, get more storage (in 1/2 MBytes) */
2219 while ( ( SpaceBetweenPointers(EndBags, stopBags) < SpaceBetweenPointers(stopBags, OldBags)/7 ||
2220 SpaceBetweenPointers(EndBags, stopBags) < WORDS_BAG(AllocSizeBags) )
2221 && SyAllocBags(512,0) )
2222 EndBags += WORDS_BAG(512*1024L);
2223
2224 /* If we are having trouble, then cut our cap to fit our cloth *.
2225 if ( EndBags - stopBags < AllocSizeBags )
2226 AllocSizeBags = 7*(Endbags - stopBags)/8; */
2227
2228 /* if less than 1/16th is free, prepare for an interrupt */
2229 if (SpaceBetweenPointers(stopBags,MptrEndBags)/15 < SpaceBetweenPointers(EndBags,stopBags) ) {
2230 /*N 1993/05/16 martin must change 'gap.c' */
2231 ;
2232 }
2233
2234 /* if more than 1/8th is free, give back storage (in 1/2 MBytes) */
2235 while (SpaceBetweenPointers(stopBags,MptrEndBags)/7 <= SpaceBetweenPointers(EndBags,stopBags)-WORDS_BAG(512*1024L)
2236 && SpaceBetweenPointers(EndBags,stopBags) > WORDS_BAG(AllocSizeBags) + WORDS_BAG(512*1024L)
2237 && SyAllocBags(-512,0) )
2238 EndBags -= WORDS_BAG(512*1024L);
2239
2240 #ifdef GAP_MEM_CHECK
2241 UInt SpareMasterPointers = 100000;
2242 #else
2243 UInt SpareMasterPointers = SpaceBetweenPointers(EndBags, stopBags)/7;
2244 #endif
2245 /* if we want to increase the masterpointer area */
2246 if ( SizeMptrsArea-NrLiveBags < SpareMasterPointers ) {
2247 /* this is how many new masterpointers we want */
2248 i = SpareMasterPointers - (SizeMptrsArea-NrLiveBags);
2249 /* move the bags area */
2250 SyMemmove(OldBags+i, OldBags, SizeAllBagsArea*sizeof(*OldBags));
2251
2252 /* update the masterpointers */
2253 for ( p = MptrBags; p < MptrEndBags; p++ ) {
2254 if ( (Bag)MptrEndBags <= *p)
2255 *p += i;
2256 }
2257
2258 /* link the new part of the masterpointer area */
2259 for ( p = MptrEndBags;
2260 p + 2*SIZE_MPTR_BAGS <= MptrEndBags+i;
2261 p += SIZE_MPTR_BAGS ) {
2262 *p = (Bag)(p + SIZE_MPTR_BAGS);
2263 }
2264 *p = (Bag)FreeMptrBags;
2265 FreeMptrBags = (Bag)MptrEndBags;
2266
2267 /* update 'MptrEndBags', 'OldBags', 'YoungBags', 'AllocBags', and 'stopBags' */
2268 MptrEndBags += i;
2269 OldBags += i;
2270 YoungBags += i;
2271 AllocBags += i;
2272 stopBags += i;
2273 }
2274
2275 /* now we are done */
2276 done = 1;
2277
2278 }
2279
2280 /* information after the check phase */
2281 SyMsgsBags(FullBags, 5, (EndBags - stopBags) / (1024 / sizeof(Bag)));
2282 SyMsgsBags(FullBags, 6, SizeWorkspace / (1024 / sizeof(Bag)));
2283
2284 // if we are not done, then try again
2285 if ( ! done ) {
2286 FullBags = 1;
2287 goto again;
2288 }
2289
2290 // call the after functions (if any)
2291 for (i = 0; i < CollectFuncBags.nrAfter; ++i)
2292 CollectFuncBags.after[i]();
2293
2294
2295 #ifdef DEBUG_MASTERPOINTERS
2296 CheckMasterPointers();
2297 #endif
2298
2299 /* Possibly advise the operating system about unused pages: */
2300 SyMAdviseFree();
2301
2302 CANARY_ALLOW_ACCESS_ALL_BAGS();
2303 CANARY_ENABLE_VALGRIND();
2304
2305 GAP_ASSERT(SanityCheckGasmanPointers());
2306
2307 /* return success */
2308 return 1;
2309 }
2310
2311
2312 /****************************************************************************
2313 **
2314 *F CheckMasterPointers() . . . . do consistency checks on the masterpointers
2315 **
2316 */
CheckMasterPointers(void)2317 void CheckMasterPointers( void )
2318 {
2319 Bag bag;
2320
2321 // iterate over all bag identifiers
2322 for (Bag * ptr = MptrBags; ptr < MptrEndBags; ptr++) {
2323 bag = (Bag)ptr;
2324
2325 // weakly dead bag?
2326 if (*ptr == (Bag)NewWeakDeadBagMarker ||
2327 *ptr == (Bag)OldWeakDeadBagMarker)
2328 continue;
2329
2330 // part of chain of free master pointers?
2331 if (*ptr == 0 || IS_BAG_ID(*ptr)) {
2332 continue;
2333 }
2334
2335 // none of the above, so it must be an active master pointer
2336 // otherwise, error out
2337 if (!IS_BAG_BODY(*ptr))
2338 Panic("Bad master pointer detected");
2339
2340 if (GET_MARK_BITS(LINK_BAG(bag))) {
2341 Panic("Master pointer with Mark bits detected");
2342 }
2343
2344 // sanity check: the link pointer must either point back; or else
2345 // this bag must be part of the chain of changed bags (which thus
2346 // must be non-empty)
2347 if (ChangedBags == 0 && LINK_BAG(bag) != bag) {
2348 Panic("Master pointer with bad link word detected");
2349 }
2350
2351 }
2352
2353 // check the chain of free master pointers
2354 bag = FreeMptrBags;
2355 while (bag != 0) {
2356 if (!IS_BAG_ID(bag))
2357 Panic("Bad chain of free master pointers detected");
2358 bag = (Bag)*bag;
2359 }
2360 }
2361
2362
2363 // Swap the master pointers of bag1 and bag2
2364 //
2365 // We need to make sure the correct bags are garbage collected, so we always put
2366 // *both* bags on the ChangedBags linked-list, rather than pick through the
2367 // exact cases, as it is never incorrect to mark something changed.
2368 //
2369 // For completeness and future reference here are the necessary points to
2370 // consider.
2371 //
2372 // When swapping two master pointers, we have to take into account whether the
2373 // bags they refer are on the ChangedBags list, as we otherwise may end up in an
2374 // inconsistent state, where a bag is referenced, but GASMAN does not know this.
2375 // GASMAN then collects this bag, resulting in a corrupted workspace.
2376 //
2377 // We consider the following three cases:
2378 //
2379 // 1. Both bags are old. Then if the original bag1 had been previously marked as
2380 // changed (by having been put into the ChangedBags singly linked list), then
2381 // we must make sure to mark the new bag2 as changed, too (and vice-versa).
2382 //
2383 // 2. Both bags are young. Then they typically will not be on the list of
2384 // changed bags, as CHANGED_BAGS just skips them.
2385 // However, while CHANGED_BAG will never put a young bag on the list of
2386 // changed bags, young bags can still be put on the ChangedBags list in
2387 // step 3, so we need to do something similar as in step 1.
2388 //
2389 // 3. bag1 is young and bag2 is old (or vice-versa), then after swapping, bag1
2390 // is old and bag2 is young, as the 'young'ness moves with the contents, so
2391 // we must mark bag1 changed if bag2 was previously changed.
2392 //
2393 // More importantly, bag2 is now young, but the only references to bag2 might
2394 // be in an old bag, that is not marked changed. Thus bag2 would get
2395 // (incorrectly) collected, because these bags are not considered in a
2396 // garbage collection.
2397 //
2398 // To avoid this we force bag2 onto the ChangedBags list, but we can't use
2399 // CHANGED_BAG, as it skips young bags.
2400 //
SwapMasterPoint(Bag bag1,Bag bag2)2401 void SwapMasterPoint(Bag bag1, Bag bag2)
2402 {
2403 Bag * swapptr;
2404 Bag swapbag;
2405
2406 if (bag1 == bag2)
2407 return;
2408
2409 // First make sure both bags are in change list
2410 // We can't use CHANGED_BAG as it skips young bags
2411 if (LINK_BAG(bag1) == bag1) {
2412 LINK_BAG(bag1) = ChangedBags;
2413 ChangedBags = bag1;
2414 }
2415 if (LINK_BAG(bag2) == bag2) {
2416 LINK_BAG(bag2) = ChangedBags;
2417 ChangedBags = bag2;
2418 }
2419
2420 // get the pointers & swap them
2421 swapptr = PTR_BAG(bag1);
2422 SET_PTR_BAG(bag1, PTR_BAG(bag2));
2423 SET_PTR_BAG(bag2, swapptr);
2424
2425 // Now swap links, so in the end the list will go
2426 // through the bags in the same order.
2427 swapbag = LINK_BAG(bag1);
2428 LINK_BAG(bag1) = LINK_BAG(bag2);
2429 LINK_BAG(bag2) = swapbag;
2430 }
2431