Make clearNursery free
[ghc.git] / rts / sm / Storage.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2012
4 *
5 * Storage manager front end
6 *
7 * Documentation on the architecture of the Storage Manager can be
8 * found in the online commentary:
9 *
10 * http://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage
11 *
12 * ---------------------------------------------------------------------------*/
13
14 #include "PosixSource.h"
15 #include "Rts.h"
16
17 #include "Storage.h"
18 #include "GCThread.h"
19 #include "RtsUtils.h"
20 #include "Stats.h"
21 #include "BlockAlloc.h"
22 #include "Weak.h"
23 #include "Sanity.h"
24 #include "Arena.h"
25 #include "Capability.h"
26 #include "Schedule.h"
27 #include "RetainerProfile.h" // for counting memory blocks (memInventory)
28 #include "OSMem.h"
29 #include "Trace.h"
30 #include "GC.h"
31 #include "Evac.h"
32 #if defined(ios_HOST_OS)
33 #include "Hash.h"
34 #endif
35
36 #include <string.h>
37
38 #include "ffi.h"
39
40 /*
41 * All these globals require sm_mutex to access in THREADED_RTS mode.
42 */
43 StgIndStatic *dyn_caf_list = NULL;
44 StgIndStatic *debug_caf_list = NULL;
45 StgIndStatic *revertible_caf_list = NULL;
46 rtsBool keepCAFs;
47
48 W_ large_alloc_lim; /* GC if n_large_blocks in any nursery
49 * reaches this. */
50
51 bdescr *exec_block;
52
53 generation *generations = NULL; /* all the generations */
54 generation *g0 = NULL; /* generation 0, for convenience */
55 generation *oldest_gen = NULL; /* oldest generation, for convenience */
56
57 nursery *nurseries = NULL; /* array of nurseries, size == n_capabilities */
58
59 #ifdef THREADED_RTS
60 /*
61 * Storage manager mutex: protects all the above state from
62 * simultaneous access by two STG threads.
63 */
64 Mutex sm_mutex;
65 #endif
66
67 static void allocNurseries (nat from, nat to);
68
69 static void
70 initGeneration (generation *gen, int g)
71 {
72 gen->no = g;
73 gen->collections = 0;
74 gen->par_collections = 0;
75 gen->failed_promotions = 0;
76 gen->max_blocks = 0;
77 gen->blocks = NULL;
78 gen->n_blocks = 0;
79 gen->n_words = 0;
80 gen->live_estimate = 0;
81 gen->old_blocks = NULL;
82 gen->n_old_blocks = 0;
83 gen->large_objects = NULL;
84 gen->n_large_blocks = 0;
85 gen->n_large_words = 0;
86 gen->n_new_large_words = 0;
87 gen->scavenged_large_objects = NULL;
88 gen->n_scavenged_large_blocks = 0;
89 gen->mark = 0;
90 gen->compact = 0;
91 gen->bitmap = NULL;
92 #ifdef THREADED_RTS
93 initSpinLock(&gen->sync);
94 #endif
95 gen->threads = END_TSO_QUEUE;
96 gen->old_threads = END_TSO_QUEUE;
97 gen->weak_ptr_list = NULL;
98 gen->old_weak_ptr_list = NULL;
99 }
100
101 void
102 initStorage (void)
103 {
104 nat g;
105
106 if (generations != NULL) {
107 // multi-init protection
108 return;
109 }
110
111 initMBlocks();
112
113 /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be
114 * doing something reasonable.
115 */
116 /* We use the NOT_NULL variant or gcc warns that the test is always true */
117 ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL((StgWord)&stg_BLOCKING_QUEUE_CLEAN_info));
118 ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure));
119 ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure));
120
121 if (RtsFlags.GcFlags.maxHeapSize != 0 &&
122 RtsFlags.GcFlags.heapSizeSuggestion >
123 RtsFlags.GcFlags.maxHeapSize) {
124 RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
125 }
126
127 if (RtsFlags.GcFlags.maxHeapSize != 0 &&
128 RtsFlags.GcFlags.minAllocAreaSize >
129 RtsFlags.GcFlags.maxHeapSize) {
130 errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
131 RtsFlags.GcFlags.minAllocAreaSize = RtsFlags.GcFlags.maxHeapSize;
132 }
133
134 initBlockAllocator();
135
136 #if defined(THREADED_RTS)
137 initMutex(&sm_mutex);
138 #endif
139
140 ACQUIRE_SM_LOCK;
141
142 /* allocate generation info array */
143 generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations
144 * sizeof(struct generation_),
145 "initStorage: gens");
146
147 /* Initialise all generations */
148 for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
149 initGeneration(&generations[g], g);
150 }
151
152 /* A couple of convenience pointers */
153 g0 = &generations[0];
154 oldest_gen = &generations[RtsFlags.GcFlags.generations-1];
155
156 /* Set up the destination pointers in each younger gen. step */
157 for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
158 generations[g].to = &generations[g+1];
159 }
160 oldest_gen->to = oldest_gen;
161
162 /* The oldest generation has one step. */
163 if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) {
164 if (RtsFlags.GcFlags.generations == 1) {
165 errorBelch("WARNING: compact/sweep is incompatible with -G1; disabled");
166 } else {
167 oldest_gen->mark = 1;
168 if (RtsFlags.GcFlags.compact)
169 oldest_gen->compact = 1;
170 }
171 }
172
173 generations[0].max_blocks = 0;
174
175 dyn_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
176 debug_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
177 revertible_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
178
179 /* initialise the allocate() interface */
180 large_alloc_lim = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W;
181
182 exec_block = NULL;
183
184 #ifdef THREADED_RTS
185 initSpinLock(&gc_alloc_block_sync);
186 #ifdef PROF_SPIN
187 whitehole_spin = 0;
188 #endif
189 #endif
190
191 N = 0;
192
193 storageAddCapabilities(0, n_capabilities);
194
195 IF_DEBUG(gc, statDescribeGens());
196
197 RELEASE_SM_LOCK;
198
199 traceEventHeapInfo(CAPSET_HEAP_DEFAULT,
200 RtsFlags.GcFlags.generations,
201 RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE_W * sizeof(W_),
202 RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W * sizeof(W_),
203 MBLOCK_SIZE_W * sizeof(W_),
204 BLOCK_SIZE_W * sizeof(W_));
205 }
206
207 void storageAddCapabilities (nat from, nat to)
208 {
209 nat n, g, i;
210
211 if (from > 0) {
212 nurseries = stgReallocBytes(nurseries, to * sizeof(struct nursery_),
213 "storageAddCapabilities");
214 } else {
215 nurseries = stgMallocBytes(to * sizeof(struct nursery_),
216 "storageAddCapabilities");
217 }
218
219 // we've moved the nurseries, so we have to update the rNursery
220 // pointers from the Capabilities.
221 for (i = 0; i < to; i++) {
222 capabilities[i]->r.rNursery = &nurseries[i];
223 }
224
225 /* The allocation area. Policy: keep the allocation area
226 * small to begin with, even if we have a large suggested heap
227 * size. Reason: we're going to do a major collection first, and we
228 * don't want it to be a big one. This vague idea is borne out by
229 * rigorous experimental evidence.
230 */
231 allocNurseries(from, to);
232
233 // allocate a block for each mut list
234 for (n = from; n < to; n++) {
235 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
236 capabilities[n]->mut_lists[g] = allocBlock();
237 }
238 }
239
240 #if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0)
241 newThreadLocalKey(&gctKey);
242 #endif
243
244 initGcThreads(from, to);
245 }
246
247
248 void
249 exitStorage (void)
250 {
251 updateNurseriesStats();
252 stat_exit();
253 }
254
255 void
256 freeStorage (rtsBool free_heap)
257 {
258 stgFree(generations);
259 if (free_heap) freeAllMBlocks();
260 #if defined(THREADED_RTS)
261 closeMutex(&sm_mutex);
262 #endif
263 stgFree(nurseries);
264 #if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0)
265 freeThreadLocalKey(&gctKey);
266 #endif
267 freeGcThreads();
268 }
269
270 /* -----------------------------------------------------------------------------
271 Note [CAF management].
272
273 The entry code for every CAF does the following:
274
275 - calls newCaf, which builds a CAF_BLACKHOLE on the heap and atomically
276 updates the CAF with IND_STATIC pointing to the CAF_BLACKHOLE
277
278 - if newCaf returns zero, it re-enters the CAF (see Note [atomic
279 CAF entry])
280
281 - pushes an update frame pointing to the CAF_BLACKHOLE
282
283 Why do we build an BLACKHOLE in the heap rather than just updating
284 the thunk directly? It's so that we only need one kind of update
285 frame - otherwise we'd need a static version of the update frame
286 too, and various other parts of the RTS that deal with update
287 frames would also need special cases for static update frames.
288
289 newCaf() does the following:
290
291 - atomically locks the CAF (see [atomic CAF entry])
292
293 - it builds a CAF_BLACKHOLE on the heap
294
295 - it updates the CAF with an IND_STATIC pointing to the
296 CAF_BLACKHOLE, atomically.
297
298 - it puts the CAF on the oldest generation's mutable list.
299 This is so that we treat the CAF as a root when collecting
300 younger generations.
301
302 - links the CAF onto the CAF list (see below)
303
304 ------------------
305 Note [atomic CAF entry]
306
307 With THREADED_RTS, newCaf() is required to be atomic (see
308 #5558). This is because if two threads happened to enter the same
309 CAF simultaneously, they would create two distinct CAF_BLACKHOLEs,
310 and so the normal threadPaused() machinery for detecting duplicate
311 evaluation will not detect this. Hence in lockCAF() below, we
312 atomically lock the CAF with WHITEHOLE before updating it with
313 IND_STATIC, and return zero if another thread locked the CAF first.
314 In the event that we lost the race, CAF entry code will re-enter
315 the CAF and block on the other thread's CAF_BLACKHOLE.
316
317 ------------------
318 Note [GHCi CAFs]
319
320 For GHCI, we have additional requirements when dealing with CAFs:
321
322 - we must *retain* all dynamically-loaded CAFs ever entered,
323 just in case we need them again.
324 - we must be able to *revert* CAFs that have been evaluated, to
325 their pre-evaluated form.
326
327 To do this, we use an additional CAF list. When newCaf() is
328 called on a dynamically-loaded CAF, we add it to the CAF list
329 instead of the old-generation mutable list, and save away its
330 old info pointer (in caf->saved_info) for later reversion.
331
332 To revert all the CAFs, we traverse the CAF list and reset the
333 info pointer to caf->saved_info, then throw away the CAF list.
334 (see GC.c:revertCAFs()).
335
336 -- SDM 29/1/01
337
338 -------------------------------------------------------------------------- */
339
340 STATIC_INLINE StgInd *
341 lockCAF (StgRegTable *reg, StgIndStatic *caf)
342 {
343 const StgInfoTable *orig_info;
344 Capability *cap = regTableToCapability(reg);
345 StgInd *bh;
346
347 orig_info = caf->header.info;
348
349 #ifdef THREADED_RTS
350 const StgInfoTable *cur_info;
351
352 if (orig_info == &stg_IND_STATIC_info ||
353 orig_info == &stg_WHITEHOLE_info) {
354 // already claimed by another thread; re-enter the CAF
355 return NULL;
356 }
357
358 cur_info = (const StgInfoTable *)
359 cas((StgVolatilePtr)&caf->header.info,
360 (StgWord)orig_info,
361 (StgWord)&stg_WHITEHOLE_info);
362
363 if (cur_info != orig_info) {
364 // already claimed by another thread; re-enter the CAF
365 return NULL;
366 }
367
368 // successfully claimed by us; overwrite with IND_STATIC
369 #endif
370
371 // For the benefit of revertCAFs(), save the original info pointer
372 caf->saved_info = orig_info;
373
374 // Allocate the blackhole indirection closure
375 bh = (StgInd *)allocate(cap, sizeofW(*bh));
376 SET_HDR(bh, &stg_CAF_BLACKHOLE_info, caf->header.prof.ccs);
377 bh->indirectee = (StgClosure *)cap->r.rCurrentTSO;
378
379 caf->indirectee = (StgClosure *)bh;
380 write_barrier();
381 SET_INFO((StgClosure*)caf,&stg_IND_STATIC_info);
382
383 return bh;
384 }
385
386 StgInd *
387 newCAF(StgRegTable *reg, StgIndStatic *caf)
388 {
389 StgInd *bh;
390
391 bh = lockCAF(reg, caf);
392 if (!bh) return NULL;
393
394 if(keepCAFs)
395 {
396 // Note [dyn_caf_list]
397 // If we are in GHCi _and_ we are using dynamic libraries,
398 // then we can't redirect newCAF calls to newDynCAF (see below),
399 // so we make newCAF behave almost like newDynCAF.
400 // The dynamic libraries might be used by both the interpreted
401 // program and GHCi itself, so they must not be reverted.
402 // This also means that in GHCi with dynamic libraries, CAFs are not
403 // garbage collected. If this turns out to be a problem, we could
404 // do another hack here and do an address range test on caf to figure
405 // out whether it is from a dynamic library.
406
407 ACQUIRE_SM_LOCK; // dyn_caf_list is global, locked by sm_mutex
408 caf->static_link = (StgClosure*)dyn_caf_list;
409 dyn_caf_list = caf;
410 RELEASE_SM_LOCK;
411 }
412 else
413 {
414 // Put this CAF on the mutable list for the old generation.
415 if (oldest_gen->no != 0) {
416 recordMutableCap((StgClosure*)caf,
417 regTableToCapability(reg), oldest_gen->no);
418 }
419
420 #ifdef DEBUG
421 // In the DEBUG rts, we keep track of live CAFs by chaining them
422 // onto a list debug_caf_list. This is so that we can tell if we
423 // ever enter a GC'd CAF, and emit a suitable barf().
424 //
425 // The saved_info field of the CAF is used as the link field for
426 // debug_caf_list, because this field is only used by newDynCAF
427 // for revertible CAFs, and we don't put those on the
428 // debug_caf_list.
429 ACQUIRE_SM_LOCK; // debug_caf_list is global, locked by sm_mutex
430 ((StgIndStatic *)caf)->saved_info = (const StgInfoTable*)debug_caf_list;
431 debug_caf_list = (StgIndStatic*)caf;
432 RELEASE_SM_LOCK;
433 #endif
434 }
435
436 return bh;
437 }
438
439 // External API for setting the keepCAFs flag. see #3900.
440 void
441 setKeepCAFs (void)
442 {
443 keepCAFs = 1;
444 }
445
446 // An alternate version of newCaf which is used for dynamically loaded
447 // object code in GHCi. In this case we want to retain *all* CAFs in
448 // the object code, because they might be demanded at any time from an
449 // expression evaluated on the command line.
450 // Also, GHCi might want to revert CAFs, so we add these to the
451 // revertible_caf_list.
452 //
453 // The linker hackily arranges that references to newCaf from dynamic
454 // code end up pointing to newDynCAF.
455 StgInd *
456 newDynCAF (StgRegTable *reg, StgIndStatic *caf)
457 {
458 StgInd *bh;
459
460 bh = lockCAF(reg, caf);
461 if (!bh) return NULL;
462
463 ACQUIRE_SM_LOCK;
464
465 caf->static_link = (StgClosure*)revertible_caf_list;
466 revertible_caf_list = caf;
467
468 RELEASE_SM_LOCK;
469
470 return bh;
471 }
472
473 /* -----------------------------------------------------------------------------
474 Nursery management.
475 -------------------------------------------------------------------------- */
476
477 static bdescr *
478 allocNursery (bdescr *tail, W_ blocks)
479 {
480 bdescr *bd = NULL;
481 W_ i, n;
482
483 // We allocate the nursery as a single contiguous block and then
484 // divide it into single blocks manually. This way we guarantee
485 // that the nursery blocks are adjacent, so that the processor's
486 // automatic prefetching works across nursery blocks. This is a
487 // tiny optimisation (~0.5%), but it's free.
488
489 while (blocks > 0) {
490 n = stg_min(BLOCKS_PER_MBLOCK, blocks);
491 // allocLargeChunk will prefer large chunks, but will pick up
492 // small chunks if there are any available. We must allow
493 // single blocks here to avoid fragmentation (#7257)
494 bd = allocLargeChunk(1, n);
495 n = bd->blocks;
496 blocks -= n;
497
498 for (i = 0; i < n; i++) {
499 initBdescr(&bd[i], g0, g0);
500
501 bd[i].blocks = 1;
502 bd[i].flags = 0;
503
504 if (i > 0) {
505 bd[i].u.back = &bd[i-1];
506 } else {
507 bd[i].u.back = NULL;
508 }
509
510 if (i+1 < n) {
511 bd[i].link = &bd[i+1];
512 } else {
513 bd[i].link = tail;
514 if (tail != NULL) {
515 tail->u.back = &bd[i];
516 }
517 }
518
519 bd[i].free = bd[i].start;
520 }
521
522 tail = &bd[0];
523 }
524
525 return &bd[0];
526 }
527
528 static void
529 assignNurseriesToCapabilities (nat from, nat to)
530 {
531 nat i;
532
533 for (i = from; i < to; i++) {
534 capabilities[i]->r.rCurrentNursery = nurseries[i].blocks;
535 newNurseryBlock(nurseries[i].blocks);
536 capabilities[i]->r.rCurrentAlloc = NULL;
537 }
538 }
539
540 static void
541 allocNurseries (nat from, nat to)
542 {
543 nat i;
544
545 for (i = from; i < to; i++) {
546 nurseries[i].blocks =
547 allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
548 nurseries[i].n_blocks =
549 RtsFlags.GcFlags.minAllocAreaSize;
550 }
551 assignNurseriesToCapabilities(from, to);
552 }
553
554 void
555 clearNursery (Capability *cap USED_IF_DEBUG)
556 {
557 #ifdef DEBUG
558 bdescr *bd;
559 for (bd = nurseries[cap->no].blocks; bd; bd = bd->link) {
560 ASSERT(bd->gen_no == 0);
561 ASSERT(bd->gen == g0);
562 IF_DEBUG(sanity, memset(bd->start, 0xaa, BLOCK_SIZE));
563 }
564 #endif
565 }
566
567 void
568 resetNurseries (void)
569 {
570 assignNurseriesToCapabilities(0, n_capabilities);
571 }
572
573 W_
574 countNurseryBlocks (void)
575 {
576 nat i;
577 W_ blocks = 0;
578
579 for (i = 0; i < n_capabilities; i++) {
580 blocks += nurseries[i].n_blocks;
581 }
582 return blocks;
583 }
584
585 static void
586 resizeNursery (nursery *nursery, W_ blocks)
587 {
588 bdescr *bd;
589 W_ nursery_blocks;
590
591 nursery_blocks = nursery->n_blocks;
592 if (nursery_blocks == blocks) return;
593
594 if (nursery_blocks < blocks) {
595 debugTrace(DEBUG_gc, "increasing size of nursery to %d blocks",
596 blocks);
597 nursery->blocks = allocNursery(nursery->blocks, blocks-nursery_blocks);
598 }
599 else {
600 bdescr *next_bd;
601
602 debugTrace(DEBUG_gc, "decreasing size of nursery to %d blocks",
603 blocks);
604
605 bd = nursery->blocks;
606 while (nursery_blocks > blocks) {
607 next_bd = bd->link;
608 next_bd->u.back = NULL;
609 nursery_blocks -= bd->blocks; // might be a large block
610 freeGroup(bd);
611 bd = next_bd;
612 }
613 nursery->blocks = bd;
614 // might have gone just under, by freeing a large block, so make
615 // up the difference.
616 if (nursery_blocks < blocks) {
617 nursery->blocks = allocNursery(nursery->blocks, blocks-nursery_blocks);
618 }
619 }
620
621 nursery->n_blocks = blocks;
622 ASSERT(countBlocks(nursery->blocks) == nursery->n_blocks);
623 }
624
625 //
626 // Resize each of the nurseries to the specified size.
627 //
628 void
629 resizeNurseriesFixed (W_ blocks)
630 {
631 nat i;
632 for (i = 0; i < n_capabilities; i++) {
633 resizeNursery(&nurseries[i], blocks);
634 }
635 }
636
637 //
638 // Resize the nurseries to the total specified size.
639 //
640 void
641 resizeNurseries (W_ blocks)
642 {
643 // If there are multiple nurseries, then we just divide the number
644 // of available blocks between them.
645 resizeNurseriesFixed(blocks / n_capabilities);
646 }
647
648
649 /* -----------------------------------------------------------------------------
650 move_STACK is called to update the TSO structure after it has been
651 moved from one place to another.
652 -------------------------------------------------------------------------- */
653
654 void
655 move_STACK (StgStack *src, StgStack *dest)
656 {
657 ptrdiff_t diff;
658
659 // relocate the stack pointer...
660 diff = (StgPtr)dest - (StgPtr)src; // In *words*
661 dest->sp = (StgPtr)dest->sp + diff;
662 }
663
664 /* -----------------------------------------------------------------------------
665 StgPtr allocate (Capability *cap, W_ n)
666
667 Allocates an area of memory n *words* large, from the nursery of
668 the supplied Capability, or from the global block pool if the area
669 requested is larger than LARGE_OBJECT_THRESHOLD. Memory is not
670 allocated from the current nursery block, so as not to interfere
671 with Hp/HpLim.
672
673 The address of the allocated memory is returned. allocate() never
674 fails; if it returns, the returned value is a valid address. If
675 the nursery is already full, then another block is allocated from
676 the global block pool. If we need to get memory from the OS and
677 that operation fails, then the whole process will be killed.
678 -------------------------------------------------------------------------- */
679
680 StgPtr allocate (Capability *cap, W_ n)
681 {
682 bdescr *bd;
683 StgPtr p;
684
685 TICK_ALLOC_HEAP_NOCTR(WDS(n));
686 CCS_ALLOC(cap->r.rCCCS,n);
687 if (cap->r.rCurrentTSO != NULL) {
688 cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_);
689 }
690
691 if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
692 // The largest number of words such that
693 // the computation of req_blocks will not overflow.
694 W_ max_words = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_);
695 W_ req_blocks;
696
697 if (n > max_words)
698 req_blocks = HS_WORD_MAX; // signal overflow below
699 else
700 req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
701
702 // Attempting to allocate an object larger than maxHeapSize
703 // should definitely be disallowed. (bug #1791)
704 if ((RtsFlags.GcFlags.maxHeapSize > 0 &&
705 req_blocks >= RtsFlags.GcFlags.maxHeapSize) ||
706 req_blocks >= HS_INT32_MAX) // avoid overflow when
707 // calling allocGroup() below
708 {
709 heapOverflow();
710 // heapOverflow() doesn't exit (see #2592), but we aren't
711 // in a position to do a clean shutdown here: we
712 // either have to allocate the memory or exit now.
713 // Allocating the memory would be bad, because the user
714 // has requested that we not exceed maxHeapSize, so we
715 // just exit.
716 stg_exit(EXIT_HEAPOVERFLOW);
717 }
718
719 ACQUIRE_SM_LOCK
720 bd = allocGroup(req_blocks);
721 dbl_link_onto(bd, &g0->large_objects);
722 g0->n_large_blocks += bd->blocks; // might be larger than req_blocks
723 g0->n_new_large_words += n;
724 RELEASE_SM_LOCK;
725 initBdescr(bd, g0, g0);
726 bd->flags = BF_LARGE;
727 bd->free = bd->start + n;
728 cap->total_allocated += n;
729 return bd->start;
730 }
731
732 /* small allocation (<LARGE_OBJECT_THRESHOLD) */
733
734 bd = cap->r.rCurrentAlloc;
735 if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
736
737 if (bd) finishedNurseryBlock(cap,bd);
738
739 // The CurrentAlloc block is full, we need to find another
740 // one. First, we try taking the next block from the
741 // nursery:
742 bd = cap->r.rCurrentNursery->link;
743
744 if (bd == NULL) {
745 // The nursery is empty: allocate a fresh block (we can't
746 // fail here).
747 ACQUIRE_SM_LOCK;
748 bd = allocBlock();
749 cap->r.rNursery->n_blocks++;
750 RELEASE_SM_LOCK;
751 initBdescr(bd, g0, g0);
752 bd->flags = 0;
753 // If we had to allocate a new block, then we'll GC
754 // pretty quickly now, because MAYBE_GC() will
755 // notice that CurrentNursery->link is NULL.
756 } else {
757 newNurseryBlock(bd);
758 // we have a block in the nursery: take it and put
759 // it at the *front* of the nursery list, and use it
760 // to allocate() from.
761 //
762 // Previously the nursery looked like this:
763 //
764 // CurrentNursery
765 // /
766 // +-+ +-+
767 // nursery -> ... |A| -> |B| -> ...
768 // +-+ +-+
769 //
770 // After doing this, it looks like this:
771 //
772 // CurrentNursery
773 // /
774 // +-+ +-+
775 // nursery -> |B| -> ... -> |A| -> ...
776 // +-+ +-+
777 // |
778 // CurrentAlloc
779 //
780 // The point is to get the block out of the way of the
781 // advancing CurrentNursery pointer, while keeping it
782 // on the nursery list so we don't lose track of it.
783 cap->r.rCurrentNursery->link = bd->link;
784 if (bd->link != NULL) {
785 bd->link->u.back = cap->r.rCurrentNursery;
786 }
787 }
788 dbl_link_onto(bd, &cap->r.rNursery->blocks);
789 cap->r.rCurrentAlloc = bd;
790 IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
791 }
792 p = bd->free;
793 bd->free += n;
794
795 IF_DEBUG(sanity, ASSERT(*((StgWord8*)p) == 0xaa));
796 return p;
797 }
798
799 /* ---------------------------------------------------------------------------
800 Allocate a fixed/pinned object.
801
802 We allocate small pinned objects into a single block, allocating a
803 new block when the current one overflows. The block is chained
804 onto the large_object_list of generation 0.
805
806 NOTE: The GC can't in general handle pinned objects. This
807 interface is only safe to use for ByteArrays, which have no
808 pointers and don't require scavenging. It works because the
809 block's descriptor has the BF_LARGE flag set, so the block is
810 treated as a large object and chained onto various lists, rather
811 than the individual objects being copied. However, when it comes
812 to scavenge the block, the GC will only scavenge the first object.
813 The reason is that the GC can't linearly scan a block of pinned
814 objects at the moment (doing so would require using the
815 mostly-copying techniques). But since we're restricting ourselves
816 to pinned ByteArrays, not scavenging is ok.
817
818 This function is called by newPinnedByteArray# which immediately
819 fills the allocated memory with a MutableByteArray#.
820 ------------------------------------------------------------------------- */
821
822 StgPtr
823 allocatePinned (Capability *cap, W_ n)
824 {
825 StgPtr p;
826 bdescr *bd;
827
828 // If the request is for a large object, then allocate()
829 // will give us a pinned object anyway.
830 if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
831 p = allocate(cap, n);
832 Bdescr(p)->flags |= BF_PINNED;
833 return p;
834 }
835
836 TICK_ALLOC_HEAP_NOCTR(WDS(n));
837 CCS_ALLOC(cap->r.rCCCS,n);
838 if (cap->r.rCurrentTSO != NULL) {
839 cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_);
840 }
841
842 bd = cap->pinned_object_block;
843
844 // If we don't have a block of pinned objects yet, or the current
845 // one isn't large enough to hold the new object, get a new one.
846 if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) {
847
848 // stash the old block on cap->pinned_object_blocks. On the
849 // next GC cycle these objects will be moved to
850 // g0->large_objects.
851 if (bd != NULL) {
852 // add it to the allocation stats when the block is full
853 finishedNurseryBlock(cap, bd);
854 dbl_link_onto(bd, &cap->pinned_object_blocks);
855 }
856
857 // We need to find another block. We could just allocate one,
858 // but that means taking a global lock and we really want to
859 // avoid that (benchmarks that allocate a lot of pinned
860 // objects scale really badly if we do this).
861 //
862 // So first, we try taking the next block from the nursery, in
863 // the same way as allocate(), but note that we can only take
864 // an *empty* block, because we're about to mark it as
865 // BF_PINNED | BF_LARGE.
866 bd = cap->r.rCurrentNursery->link;
867 if (bd == NULL) { // must be empty!
868 // The nursery is empty, or the next block is non-empty:
869 // allocate a fresh block (we can't fail here).
870
871 // XXX in the case when the next nursery block is
872 // non-empty we aren't exerting any pressure to GC soon,
873 // so if this case ever happens then we could in theory
874 // keep allocating for ever without calling the GC. We
875 // can't bump g0->n_new_large_words because that will be
876 // counted towards allocation, and we're already counting
877 // our pinned obects as allocation in
878 // collect_pinned_object_blocks in the GC.
879 ACQUIRE_SM_LOCK;
880 bd = allocBlock();
881 RELEASE_SM_LOCK;
882 initBdescr(bd, g0, g0);
883 } else {
884 newNurseryBlock(bd);
885 // we have a block in the nursery: steal it
886 cap->r.rCurrentNursery->link = bd->link;
887 if (bd->link != NULL) {
888 bd->link->u.back = cap->r.rCurrentNursery;
889 }
890 cap->r.rNursery->n_blocks -= bd->blocks;
891 }
892
893 cap->pinned_object_block = bd;
894 bd->flags = BF_PINNED | BF_LARGE | BF_EVACUATED;
895
896 // The pinned_object_block remains attached to the capability
897 // until it is full, even if a GC occurs. We want this
898 // behaviour because otherwise the unallocated portion of the
899 // block would be forever slop, and under certain workloads
900 // (allocating a few ByteStrings per GC) we accumulate a lot
901 // of slop.
902 //
903 // So, the pinned_object_block is initially marked
904 // BF_EVACUATED so the GC won't touch it. When it is full,
905 // we place it on the large_objects list, and at the start of
906 // the next GC the BF_EVACUATED flag will be cleared, and the
907 // block will be promoted as usual (if anything in it is
908 // live).
909 }
910
911 p = bd->free;
912 bd->free += n;
913 return p;
914 }
915
916 /* -----------------------------------------------------------------------------
917 Write Barriers
918 -------------------------------------------------------------------------- */
919
920 /*
921 This is the write barrier for MUT_VARs, a.k.a. IORefs. A
922 MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
923 is. When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
924 and is put on the mutable list.
925 */
926 void
927 dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
928 {
929 Capability *cap = regTableToCapability(reg);
930 if (p->header.info == &stg_MUT_VAR_CLEAN_info) {
931 p->header.info = &stg_MUT_VAR_DIRTY_info;
932 recordClosureMutated(cap,p);
933 }
934 }
935
936 void
937 dirty_TVAR(Capability *cap, StgTVar *p)
938 {
939 if (p->header.info == &stg_TVAR_CLEAN_info) {
940 p->header.info = &stg_TVAR_DIRTY_info;
941 recordClosureMutated(cap,(StgClosure*)p);
942 }
943 }
944
945 // Setting a TSO's link field with a write barrier.
946 // It is *not* necessary to call this function when
947 // * setting the link field to END_TSO_QUEUE
948 // * putting a TSO on the blackhole_queue
949 // * setting the link field of the currently running TSO, as it
950 // will already be dirty.
951 void
952 setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target)
953 {
954 if (tso->dirty == 0) {
955 tso->dirty = 1;
956 recordClosureMutated(cap,(StgClosure*)tso);
957 }
958 tso->_link = target;
959 }
960
961 void
962 setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target)
963 {
964 if (tso->dirty == 0) {
965 tso->dirty = 1;
966 recordClosureMutated(cap,(StgClosure*)tso);
967 }
968 tso->block_info.prev = target;
969 }
970
971 void
972 dirty_TSO (Capability *cap, StgTSO *tso)
973 {
974 if (tso->dirty == 0) {
975 tso->dirty = 1;
976 recordClosureMutated(cap,(StgClosure*)tso);
977 }
978 }
979
980 void
981 dirty_STACK (Capability *cap, StgStack *stack)
982 {
983 if (stack->dirty == 0) {
984 stack->dirty = 1;
985 recordClosureMutated(cap,(StgClosure*)stack);
986 }
987 }
988
989 /*
990 This is the write barrier for MVARs. An MVAR_CLEAN objects is not
991 on the mutable list; a MVAR_DIRTY is. When written to, a
992 MVAR_CLEAN turns into a MVAR_DIRTY and is put on the mutable list.
993 The check for MVAR_CLEAN is inlined at the call site for speed,
994 this really does make a difference on concurrency-heavy benchmarks
995 such as Chaneneos and cheap-concurrency.
996 */
997 void
998 dirty_MVAR(StgRegTable *reg, StgClosure *p)
999 {
1000 recordClosureMutated(regTableToCapability(reg),p);
1001 }
1002
1003 /* -----------------------------------------------------------------------------
1004 * Stats and stuff
1005 * -------------------------------------------------------------------------- */
1006
1007 /* -----------------------------------------------------------------------------
1008 * [Note allocation accounting]
1009 *
1010 * - When cap->r.rCurrentNusery moves to a new block in the nursery,
1011 * we add the size of the used portion of the previous block to
1012 * cap->total_allocated. (see finishedNurseryBlock())
1013 *
1014 * - When we start a GC, the allocated portion of CurrentNursery and
1015 * CurrentAlloc are added to cap->total_allocated. (see
1016 * updateNurseriesStats())
1017 *
1018 * -------------------------------------------------------------------------- */
1019
1020 //
1021 // Calculate the total allocated memory since the start of the
1022 // program. Also emits events reporting the per-cap allocation
1023 // totals.
1024 //
1025 StgWord
1026 calcTotalAllocated (void)
1027 {
1028 W_ tot_alloc = 0;
1029 W_ n;
1030
1031 for (n = 0; n < n_capabilities; n++) {
1032 tot_alloc += capabilities[n]->total_allocated;
1033
1034 traceEventHeapAllocated(capabilities[n],
1035 CAPSET_HEAP_DEFAULT,
1036 capabilities[n]->total_allocated * sizeof(W_));
1037 }
1038
1039 return tot_alloc;
1040 }
1041
1042 //
1043 // Update the per-cap total_allocated numbers with an approximation of
1044 // the amount of memory used in each cap's nursery.
1045 //
1046 void
1047 updateNurseriesStats (void)
1048 {
1049 nat i;
1050 bdescr *bd;
1051
1052 for (i = 0; i < n_capabilities; i++) {
1053 // The current nursery block and the current allocate block have not
1054 // yet been accounted for in cap->total_allocated, so we add them here.
1055 bd = capabilities[i]->r.rCurrentNursery;
1056 if (bd) finishedNurseryBlock(capabilities[i], bd);
1057 bd = capabilities[i]->r.rCurrentAlloc;
1058 if (bd) finishedNurseryBlock(capabilities[i], bd);
1059 }
1060 }
1061
1062 W_ countOccupied (bdescr *bd)
1063 {
1064 W_ words;
1065
1066 words = 0;
1067 for (; bd != NULL; bd = bd->link) {
1068 ASSERT(bd->free <= bd->start + bd->blocks * BLOCK_SIZE_W);
1069 words += bd->free - bd->start;
1070 }
1071 return words;
1072 }
1073
1074 W_ genLiveWords (generation *gen)
1075 {
1076 return gen->n_words + gen->n_large_words;
1077 }
1078
1079 W_ genLiveBlocks (generation *gen)
1080 {
1081 return gen->n_blocks + gen->n_large_blocks;
1082 }
1083
1084 W_ gcThreadLiveWords (nat i, nat g)
1085 {
1086 W_ words;
1087
1088 words = countOccupied(gc_threads[i]->gens[g].todo_bd);
1089 words += countOccupied(gc_threads[i]->gens[g].part_list);
1090 words += countOccupied(gc_threads[i]->gens[g].scavd_list);
1091
1092 return words;
1093 }
1094
1095 W_ gcThreadLiveBlocks (nat i, nat g)
1096 {
1097 W_ blocks;
1098
1099 blocks = countBlocks(gc_threads[i]->gens[g].todo_bd);
1100 blocks += gc_threads[i]->gens[g].n_part_blocks;
1101 blocks += gc_threads[i]->gens[g].n_scavd_blocks;
1102
1103 return blocks;
1104 }
1105
1106 // Return an accurate count of the live data in the heap, excluding
1107 // generation 0.
1108 W_ calcLiveWords (void)
1109 {
1110 nat g;
1111 W_ live;
1112
1113 live = 0;
1114 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1115 live += genLiveWords(&generations[g]);
1116 }
1117 return live;
1118 }
1119
1120 W_ calcLiveBlocks (void)
1121 {
1122 nat g;
1123 W_ live;
1124
1125 live = 0;
1126 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1127 live += genLiveBlocks(&generations[g]);
1128 }
1129 return live;
1130 }
1131
1132 /* Determine which generation will be collected next, and approximate
1133 * the maximum amount of memory that will be required to do the GC,
1134 * taking into account data that will be copied, and the space needed
1135 * to store bitmaps and the mark stack. Note: blocks_needed does not
1136 * include the blocks in the nursery.
1137 *
1138 * Assume: all data currently live will remain live. Generationss
1139 * that will be collected next time will therefore need twice as many
1140 * blocks since all the data will be copied.
1141 */
1142 extern W_
1143 calcNeeded (rtsBool force_major, memcount *blocks_needed)
1144 {
1145 W_ needed = 0, blocks;
1146 nat g, N;
1147 generation *gen;
1148
1149 if (force_major) {
1150 N = RtsFlags.GcFlags.generations - 1;
1151 } else {
1152 N = 0;
1153 }
1154
1155 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1156 gen = &generations[g];
1157
1158 blocks = gen->n_blocks // or: gen->n_words / BLOCK_SIZE_W (?)
1159 + gen->n_large_blocks;
1160
1161 // we need at least this much space
1162 needed += blocks;
1163
1164 // are we collecting this gen?
1165 if (g == 0 || // always collect gen 0
1166 blocks > gen->max_blocks)
1167 {
1168 N = stg_max(N,g);
1169
1170 // we will collect this gen next time
1171 if (gen->mark) {
1172 // bitmap:
1173 needed += gen->n_blocks / BITS_IN(W_);
1174 // mark stack:
1175 needed += gen->n_blocks / 100;
1176 }
1177 if (gen->compact) {
1178 continue; // no additional space needed for compaction
1179 } else {
1180 needed += gen->n_blocks;
1181 }
1182 }
1183 }
1184
1185 if (blocks_needed != NULL) {
1186 *blocks_needed = needed;
1187 }
1188 return N;
1189 }
1190
1191 /* ----------------------------------------------------------------------------
1192 Executable memory
1193
1194 Executable memory must be managed separately from non-executable
1195 memory. Most OSs these days require you to jump through hoops to
1196 dynamically allocate executable memory, due to various security
1197 measures.
1198
1199 Here we provide a small memory allocator for executable memory.
1200 Memory is managed with a page granularity; we allocate linearly
1201 in the page, and when the page is emptied (all objects on the page
1202 are free) we free the page again, not forgetting to make it
1203 non-executable.
1204
1205 TODO: The inability to handle objects bigger than BLOCK_SIZE_W means that
1206 the linker cannot use allocateExec for loading object code files
1207 on Windows. Once allocateExec can handle larger objects, the linker
1208 should be modified to use allocateExec instead of VirtualAlloc.
1209 ------------------------------------------------------------------------- */
1210
1211 #if (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && defined(ios_HOST_OS)
1212 void sys_icache_invalidate(void *start, size_t len);
1213 #endif
1214
1215 /* On ARM and other platforms, we need to flush the cache after
1216 writing code into memory, so the processor reliably sees it. */
1217 void flushExec (W_ len, AdjustorExecutable exec_addr)
1218 {
1219 #if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)
1220 /* x86 doesn't need to do anything, so just suppress some warnings. */
1221 (void)len;
1222 (void)exec_addr;
1223 #elif (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && defined(ios_HOST_OS)
1224 /* On iOS we need to use the special 'sys_icache_invalidate' call. */
1225 sys_icache_invalidate(exec_addr, ((unsigned char*)exec_addr)+len);
1226 #elif defined(__GNUC__)
1227 /* For all other platforms, fall back to a libgcc builtin. */
1228 unsigned char* begin = (unsigned char*)exec_addr;
1229 unsigned char* end = begin + len;
1230 __clear_cache((void*)begin, (void*)end);
1231 #else
1232 #error Missing support to flush the instruction cache
1233 #endif
1234 }
1235
1236 #if defined(linux_HOST_OS)
1237
1238 // On Linux we need to use libffi for allocating executable memory,
1239 // because it knows how to work around the restrictions put in place
1240 // by SELinux.
1241
1242 AdjustorWritable allocateExec (W_ bytes, AdjustorExecutable *exec_ret)
1243 {
1244 void **ret, **exec;
1245 ACQUIRE_SM_LOCK;
1246 ret = ffi_closure_alloc (sizeof(void *) + (size_t)bytes, (void**)&exec);
1247 RELEASE_SM_LOCK;
1248 if (ret == NULL) return ret;
1249 *ret = ret; // save the address of the writable mapping, for freeExec().
1250 *exec_ret = exec + 1;
1251 return (ret + 1);
1252 }
1253
1254 // freeExec gets passed the executable address, not the writable address.
1255 void freeExec (AdjustorExecutable addr)
1256 {
1257 AdjustorWritable writable;
1258 writable = *((void**)addr - 1);
1259 ACQUIRE_SM_LOCK;
1260 ffi_closure_free (writable);
1261 RELEASE_SM_LOCK
1262 }
1263
1264 #elif defined(ios_HOST_OS)
1265
1266 static HashTable* allocatedExecs;
1267
1268 AdjustorWritable allocateExec(W_ bytes, AdjustorExecutable *exec_ret)
1269 {
1270 AdjustorWritable writ;
1271 ffi_closure* cl;
1272 if (bytes != sizeof(ffi_closure)) {
1273 barf("allocateExec: for ffi_closure only");
1274 }
1275 ACQUIRE_SM_LOCK;
1276 cl = writ = ffi_closure_alloc((size_t)bytes, exec_ret);
1277 if (cl != NULL) {
1278 if (allocatedExecs == NULL) {
1279 allocatedExecs = allocHashTable();
1280 }
1281 insertHashTable(allocatedExecs, (StgWord)*exec_ret, writ);
1282 }
1283 RELEASE_SM_LOCK;
1284 return writ;
1285 }
1286
1287 AdjustorWritable execToWritable(AdjustorExecutable exec)
1288 {
1289 AdjustorWritable writ;
1290 ACQUIRE_SM_LOCK;
1291 if (allocatedExecs == NULL ||
1292 (writ = lookupHashTable(allocatedExecs, (StgWord)exec)) == NULL) {
1293 RELEASE_SM_LOCK;
1294 barf("execToWritable: not found");
1295 }
1296 RELEASE_SM_LOCK;
1297 return writ;
1298 }
1299
1300 void freeExec(AdjustorExecutable exec)
1301 {
1302 AdjustorWritable writ;
1303 ffi_closure* cl;
1304 cl = writ = execToWritable(exec);
1305 ACQUIRE_SM_LOCK;
1306 removeHashTable(allocatedExecs, (StgWord)exec, writ);
1307 ffi_closure_free(cl);
1308 RELEASE_SM_LOCK
1309 }
1310
1311 #else
1312
1313 AdjustorWritable allocateExec (W_ bytes, AdjustorExecutable *exec_ret)
1314 {
1315 void *ret;
1316 W_ n;
1317
1318 ACQUIRE_SM_LOCK;
1319
1320 // round up to words.
1321 n = (bytes + sizeof(W_) + 1) / sizeof(W_);
1322
1323 if (n+1 > BLOCK_SIZE_W) {
1324 barf("allocateExec: can't handle large objects");
1325 }
1326
1327 if (exec_block == NULL ||
1328 exec_block->free + n + 1 > exec_block->start + BLOCK_SIZE_W) {
1329 bdescr *bd;
1330 W_ pagesize = getPageSize();
1331 bd = allocGroup(stg_max(1, pagesize / BLOCK_SIZE));
1332 debugTrace(DEBUG_gc, "allocate exec block %p", bd->start);
1333 bd->gen_no = 0;
1334 bd->flags = BF_EXEC;
1335 bd->link = exec_block;
1336 if (exec_block != NULL) {
1337 exec_block->u.back = bd;
1338 }
1339 bd->u.back = NULL;
1340 setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsTrue);
1341 exec_block = bd;
1342 }
1343 *(exec_block->free) = n; // store the size of this chunk
1344 exec_block->gen_no += n; // gen_no stores the number of words allocated
1345 ret = exec_block->free + 1;
1346 exec_block->free += n + 1;
1347
1348 RELEASE_SM_LOCK
1349 *exec_ret = ret;
1350 return ret;
1351 }
1352
1353 void freeExec (void *addr)
1354 {
1355 StgPtr p = (StgPtr)addr - 1;
1356 bdescr *bd = Bdescr((StgPtr)p);
1357
1358 if ((bd->flags & BF_EXEC) == 0) {
1359 barf("freeExec: not executable");
1360 }
1361
1362 if (*(StgPtr)p == 0) {
1363 barf("freeExec: already free?");
1364 }
1365
1366 ACQUIRE_SM_LOCK;
1367
1368 bd->gen_no -= *(StgPtr)p;
1369 *(StgPtr)p = 0;
1370
1371 if (bd->gen_no == 0) {
1372 // Free the block if it is empty, but not if it is the block at
1373 // the head of the queue.
1374 if (bd != exec_block) {
1375 debugTrace(DEBUG_gc, "free exec block %p", bd->start);
1376 dbl_link_remove(bd, &exec_block);
1377 setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse);
1378 freeGroup(bd);
1379 } else {
1380 bd->free = bd->start;
1381 }
1382 }
1383
1384 RELEASE_SM_LOCK
1385 }
1386
1387 #endif /* switch(HOST_OS) */
1388
1389 #ifdef DEBUG
1390
1391 // handy function for use in gdb, because Bdescr() is inlined.
1392 extern bdescr *_bdescr (StgPtr p);
1393
1394 bdescr *
1395 _bdescr (StgPtr p)
1396 {
1397 return Bdescr(p);
1398 }
1399
1400 #endif