7174425e04c4ec12c6a85097eccaa0faf9e6a03e
[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 capabilities[i]->r.rCurrentAlloc = NULL;
536 }
537 }
538
539 static void
540 allocNurseries (nat from, nat to)
541 {
542 nat i;
543
544 for (i = from; i < to; i++) {
545 nurseries[i].blocks =
546 allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
547 nurseries[i].n_blocks =
548 RtsFlags.GcFlags.minAllocAreaSize;
549 }
550 assignNurseriesToCapabilities(from, to);
551 }
552
553 void
554 clearNursery (Capability *cap)
555 {
556 bdescr *bd;
557
558 for (bd = nurseries[cap->no].blocks; bd; bd = bd->link) {
559 cap->total_allocated += (W_)(bd->free - bd->start);
560 bd->free = bd->start;
561 ASSERT(bd->gen_no == 0);
562 ASSERT(bd->gen == g0);
563 IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
564 }
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 // The CurrentAlloc block is full, we need to find another
738 // one. First, we try taking the next block from the
739 // nursery:
740 bd = cap->r.rCurrentNursery->link;
741
742 if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
743 // The nursery is empty, or the next block is already
744 // full: allocate a fresh block (we can't fail here).
745 ACQUIRE_SM_LOCK;
746 bd = allocBlock();
747 cap->r.rNursery->n_blocks++;
748 RELEASE_SM_LOCK;
749 initBdescr(bd, g0, g0);
750 bd->flags = 0;
751 // If we had to allocate a new block, then we'll GC
752 // pretty quickly now, because MAYBE_GC() will
753 // notice that CurrentNursery->link is NULL.
754 } else {
755 // we have a block in the nursery: take it and put
756 // it at the *front* of the nursery list, and use it
757 // to allocate() from.
758 //
759 // Previously the nursery looked like this:
760 //
761 // CurrentNursery
762 // /
763 // +-+ +-+
764 // nursery -> ... |A| -> |B| -> ...
765 // +-+ +-+
766 //
767 // After doing this, it looks like this:
768 //
769 // CurrentNursery
770 // /
771 // +-+ +-+
772 // nursery -> |B| -> ... -> |A| -> ...
773 // +-+ +-+
774 // |
775 // CurrentAlloc
776 //
777 // The point is to get the block out of the way of the
778 // advancing CurrentNursery pointer, while keeping it
779 // on the nursery list so we don't lose track of it.
780 cap->r.rCurrentNursery->link = bd->link;
781 if (bd->link != NULL) {
782 bd->link->u.back = cap->r.rCurrentNursery;
783 }
784 }
785 dbl_link_onto(bd, &cap->r.rNursery->blocks);
786 cap->r.rCurrentAlloc = bd;
787 IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
788 }
789 p = bd->free;
790 bd->free += n;
791
792 IF_DEBUG(sanity, ASSERT(*((StgWord8*)p) == 0xaa));
793 return p;
794 }
795
796 /* ---------------------------------------------------------------------------
797 Allocate a fixed/pinned object.
798
799 We allocate small pinned objects into a single block, allocating a
800 new block when the current one overflows. The block is chained
801 onto the large_object_list of generation 0.
802
803 NOTE: The GC can't in general handle pinned objects. This
804 interface is only safe to use for ByteArrays, which have no
805 pointers and don't require scavenging. It works because the
806 block's descriptor has the BF_LARGE flag set, so the block is
807 treated as a large object and chained onto various lists, rather
808 than the individual objects being copied. However, when it comes
809 to scavenge the block, the GC will only scavenge the first object.
810 The reason is that the GC can't linearly scan a block of pinned
811 objects at the moment (doing so would require using the
812 mostly-copying techniques). But since we're restricting ourselves
813 to pinned ByteArrays, not scavenging is ok.
814
815 This function is called by newPinnedByteArray# which immediately
816 fills the allocated memory with a MutableByteArray#.
817 ------------------------------------------------------------------------- */
818
819 StgPtr
820 allocatePinned (Capability *cap, W_ n)
821 {
822 StgPtr p;
823 bdescr *bd;
824
825 // If the request is for a large object, then allocate()
826 // will give us a pinned object anyway.
827 if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
828 p = allocate(cap, n);
829 Bdescr(p)->flags |= BF_PINNED;
830 return p;
831 }
832
833 TICK_ALLOC_HEAP_NOCTR(WDS(n));
834 CCS_ALLOC(cap->r.rCCCS,n);
835 if (cap->r.rCurrentTSO != NULL) {
836 cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_);
837 }
838
839 bd = cap->pinned_object_block;
840
841 // If we don't have a block of pinned objects yet, or the current
842 // one isn't large enough to hold the new object, get a new one.
843 if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) {
844
845 // stash the old block on cap->pinned_object_blocks. On the
846 // next GC cycle these objects will be moved to
847 // g0->large_objects.
848 if (bd != NULL) {
849 dbl_link_onto(bd, &cap->pinned_object_blocks);
850 // add it to the allocation stats when the block is full
851 cap->total_allocated += bd->free - bd->start;
852 }
853
854 // We need to find another block. We could just allocate one,
855 // but that means taking a global lock and we really want to
856 // avoid that (benchmarks that allocate a lot of pinned
857 // objects scale really badly if we do this).
858 //
859 // So first, we try taking the next block from the nursery, in
860 // the same way as allocate(), but note that we can only take
861 // an *empty* block, because we're about to mark it as
862 // BF_PINNED | BF_LARGE.
863 bd = cap->r.rCurrentNursery->link;
864 if (bd == NULL || bd->free != bd->start) { // must be empty!
865 // The nursery is empty, or the next block is non-empty:
866 // allocate a fresh block (we can't fail here).
867
868 // XXX in the case when the next nursery block is
869 // non-empty we aren't exerting any pressure to GC soon,
870 // so if this case ever happens then we could in theory
871 // keep allocating for ever without calling the GC. We
872 // can't bump g0->n_new_large_words because that will be
873 // counted towards allocation, and we're already counting
874 // our pinned obects as allocation in
875 // collect_pinned_object_blocks in the GC.
876 ACQUIRE_SM_LOCK;
877 bd = allocBlock();
878 RELEASE_SM_LOCK;
879 initBdescr(bd, g0, g0);
880 } else {
881 // we have a block in the nursery: steal it
882 cap->r.rCurrentNursery->link = bd->link;
883 if (bd->link != NULL) {
884 bd->link->u.back = cap->r.rCurrentNursery;
885 }
886 cap->r.rNursery->n_blocks -= bd->blocks;
887 }
888
889 cap->pinned_object_block = bd;
890 bd->flags = BF_PINNED | BF_LARGE | BF_EVACUATED;
891
892 // The pinned_object_block remains attached to the capability
893 // until it is full, even if a GC occurs. We want this
894 // behaviour because otherwise the unallocated portion of the
895 // block would be forever slop, and under certain workloads
896 // (allocating a few ByteStrings per GC) we accumulate a lot
897 // of slop.
898 //
899 // So, the pinned_object_block is initially marked
900 // BF_EVACUATED so the GC won't touch it. When it is full,
901 // we place it on the large_objects list, and at the start of
902 // the next GC the BF_EVACUATED flag will be cleared, and the
903 // block will be promoted as usual (if anything in it is
904 // live).
905 }
906
907 p = bd->free;
908 bd->free += n;
909 return p;
910 }
911
912 /* -----------------------------------------------------------------------------
913 Write Barriers
914 -------------------------------------------------------------------------- */
915
916 /*
917 This is the write barrier for MUT_VARs, a.k.a. IORefs. A
918 MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
919 is. When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
920 and is put on the mutable list.
921 */
922 void
923 dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
924 {
925 Capability *cap = regTableToCapability(reg);
926 if (p->header.info == &stg_MUT_VAR_CLEAN_info) {
927 p->header.info = &stg_MUT_VAR_DIRTY_info;
928 recordClosureMutated(cap,p);
929 }
930 }
931
932 void
933 dirty_TVAR(Capability *cap, StgTVar *p)
934 {
935 if (p->header.info == &stg_TVAR_CLEAN_info) {
936 p->header.info = &stg_TVAR_DIRTY_info;
937 recordClosureMutated(cap,(StgClosure*)p);
938 }
939 }
940
941 // Setting a TSO's link field with a write barrier.
942 // It is *not* necessary to call this function when
943 // * setting the link field to END_TSO_QUEUE
944 // * putting a TSO on the blackhole_queue
945 // * setting the link field of the currently running TSO, as it
946 // will already be dirty.
947 void
948 setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target)
949 {
950 if (tso->dirty == 0) {
951 tso->dirty = 1;
952 recordClosureMutated(cap,(StgClosure*)tso);
953 }
954 tso->_link = target;
955 }
956
957 void
958 setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target)
959 {
960 if (tso->dirty == 0) {
961 tso->dirty = 1;
962 recordClosureMutated(cap,(StgClosure*)tso);
963 }
964 tso->block_info.prev = target;
965 }
966
967 void
968 dirty_TSO (Capability *cap, StgTSO *tso)
969 {
970 if (tso->dirty == 0) {
971 tso->dirty = 1;
972 recordClosureMutated(cap,(StgClosure*)tso);
973 }
974 }
975
976 void
977 dirty_STACK (Capability *cap, StgStack *stack)
978 {
979 if (stack->dirty == 0) {
980 stack->dirty = 1;
981 recordClosureMutated(cap,(StgClosure*)stack);
982 }
983 }
984
985 /*
986 This is the write barrier for MVARs. An MVAR_CLEAN objects is not
987 on the mutable list; a MVAR_DIRTY is. When written to, a
988 MVAR_CLEAN turns into a MVAR_DIRTY and is put on the mutable list.
989 The check for MVAR_CLEAN is inlined at the call site for speed,
990 this really does make a difference on concurrency-heavy benchmarks
991 such as Chaneneos and cheap-concurrency.
992 */
993 void
994 dirty_MVAR(StgRegTable *reg, StgClosure *p)
995 {
996 recordClosureMutated(regTableToCapability(reg),p);
997 }
998
999 /* -----------------------------------------------------------------------------
1000 * Stats and stuff
1001 * -------------------------------------------------------------------------- */
1002
1003 /* -----------------------------------------------------------------------------
1004 * updateNurseriesStats()
1005 *
1006 * Update the per-cap total_allocated numbers with an approximation of
1007 * the amount of memory used in each cap's nursery.
1008 *
1009 * Since this update is also performed by clearNurseries() then we only
1010 * need this function for the final stats when the RTS is shutting down.
1011 * -------------------------------------------------------------------------- */
1012
1013 void updateNurseriesStats (void)
1014 {
1015 nat i;
1016
1017 for (i = 0; i < n_capabilities; i++) {
1018 capabilities[i]->total_allocated += countOccupied(nurseries[i].blocks);
1019 }
1020 }
1021
1022 W_ countOccupied (bdescr *bd)
1023 {
1024 W_ words;
1025
1026 words = 0;
1027 for (; bd != NULL; bd = bd->link) {
1028 ASSERT(bd->free <= bd->start + bd->blocks * BLOCK_SIZE_W);
1029 words += bd->free - bd->start;
1030 }
1031 return words;
1032 }
1033
1034 W_ genLiveWords (generation *gen)
1035 {
1036 return gen->n_words + gen->n_large_words;
1037 }
1038
1039 W_ genLiveBlocks (generation *gen)
1040 {
1041 return gen->n_blocks + gen->n_large_blocks;
1042 }
1043
1044 W_ gcThreadLiveWords (nat i, nat g)
1045 {
1046 W_ words;
1047
1048 words = countOccupied(gc_threads[i]->gens[g].todo_bd);
1049 words += countOccupied(gc_threads[i]->gens[g].part_list);
1050 words += countOccupied(gc_threads[i]->gens[g].scavd_list);
1051
1052 return words;
1053 }
1054
1055 W_ gcThreadLiveBlocks (nat i, nat g)
1056 {
1057 W_ blocks;
1058
1059 blocks = countBlocks(gc_threads[i]->gens[g].todo_bd);
1060 blocks += gc_threads[i]->gens[g].n_part_blocks;
1061 blocks += gc_threads[i]->gens[g].n_scavd_blocks;
1062
1063 return blocks;
1064 }
1065
1066 // Return an accurate count of the live data in the heap, excluding
1067 // generation 0.
1068 W_ calcLiveWords (void)
1069 {
1070 nat g;
1071 W_ live;
1072
1073 live = 0;
1074 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1075 live += genLiveWords(&generations[g]);
1076 }
1077 return live;
1078 }
1079
1080 W_ calcLiveBlocks (void)
1081 {
1082 nat g;
1083 W_ live;
1084
1085 live = 0;
1086 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1087 live += genLiveBlocks(&generations[g]);
1088 }
1089 return live;
1090 }
1091
1092 /* Determine which generation will be collected next, and approximate
1093 * the maximum amount of memory that will be required to do the GC,
1094 * taking into account data that will be copied, and the space needed
1095 * to store bitmaps and the mark stack. Note: blocks_needed does not
1096 * include the blocks in the nursery.
1097 *
1098 * Assume: all data currently live will remain live. Generationss
1099 * that will be collected next time will therefore need twice as many
1100 * blocks since all the data will be copied.
1101 */
1102 extern W_
1103 calcNeeded (rtsBool force_major, memcount *blocks_needed)
1104 {
1105 W_ needed = 0, blocks;
1106 nat g, N;
1107 generation *gen;
1108
1109 if (force_major) {
1110 N = RtsFlags.GcFlags.generations - 1;
1111 } else {
1112 N = 0;
1113 }
1114
1115 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1116 gen = &generations[g];
1117
1118 blocks = gen->n_blocks // or: gen->n_words / BLOCK_SIZE_W (?)
1119 + gen->n_large_blocks;
1120
1121 // we need at least this much space
1122 needed += blocks;
1123
1124 // are we collecting this gen?
1125 if (g == 0 || // always collect gen 0
1126 blocks > gen->max_blocks)
1127 {
1128 N = stg_max(N,g);
1129
1130 // we will collect this gen next time
1131 if (gen->mark) {
1132 // bitmap:
1133 needed += gen->n_blocks / BITS_IN(W_);
1134 // mark stack:
1135 needed += gen->n_blocks / 100;
1136 }
1137 if (gen->compact) {
1138 continue; // no additional space needed for compaction
1139 } else {
1140 needed += gen->n_blocks;
1141 }
1142 }
1143 }
1144
1145 if (blocks_needed != NULL) {
1146 *blocks_needed = needed;
1147 }
1148 return N;
1149 }
1150
1151 /* ----------------------------------------------------------------------------
1152 Executable memory
1153
1154 Executable memory must be managed separately from non-executable
1155 memory. Most OSs these days require you to jump through hoops to
1156 dynamically allocate executable memory, due to various security
1157 measures.
1158
1159 Here we provide a small memory allocator for executable memory.
1160 Memory is managed with a page granularity; we allocate linearly
1161 in the page, and when the page is emptied (all objects on the page
1162 are free) we free the page again, not forgetting to make it
1163 non-executable.
1164
1165 TODO: The inability to handle objects bigger than BLOCK_SIZE_W means that
1166 the linker cannot use allocateExec for loading object code files
1167 on Windows. Once allocateExec can handle larger objects, the linker
1168 should be modified to use allocateExec instead of VirtualAlloc.
1169 ------------------------------------------------------------------------- */
1170
1171 #if (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && defined(ios_HOST_OS)
1172 void sys_icache_invalidate(void *start, size_t len);
1173 #endif
1174
1175 /* On ARM and other platforms, we need to flush the cache after
1176 writing code into memory, so the processor reliably sees it. */
1177 void flushExec (W_ len, AdjustorExecutable exec_addr)
1178 {
1179 #if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)
1180 /* x86 doesn't need to do anything, so just suppress some warnings. */
1181 (void)len;
1182 (void)exec_addr;
1183 #elif (defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) && defined(ios_HOST_OS)
1184 /* On iOS we need to use the special 'sys_icache_invalidate' call. */
1185 sys_icache_invalidate(exec_addr, ((unsigned char*)exec_addr)+len);
1186 #elif defined(__GNUC__)
1187 /* For all other platforms, fall back to a libgcc builtin. */
1188 unsigned char* begin = (unsigned char*)exec_addr;
1189 unsigned char* end = begin + len;
1190 __clear_cache((void*)begin, (void*)end);
1191 #else
1192 #error Missing support to flush the instruction cache
1193 #endif
1194 }
1195
1196 #if defined(linux_HOST_OS)
1197
1198 // On Linux we need to use libffi for allocating executable memory,
1199 // because it knows how to work around the restrictions put in place
1200 // by SELinux.
1201
1202 AdjustorWritable allocateExec (W_ bytes, AdjustorExecutable *exec_ret)
1203 {
1204 void **ret, **exec;
1205 ACQUIRE_SM_LOCK;
1206 ret = ffi_closure_alloc (sizeof(void *) + (size_t)bytes, (void**)&exec);
1207 RELEASE_SM_LOCK;
1208 if (ret == NULL) return ret;
1209 *ret = ret; // save the address of the writable mapping, for freeExec().
1210 *exec_ret = exec + 1;
1211 return (ret + 1);
1212 }
1213
1214 // freeExec gets passed the executable address, not the writable address.
1215 void freeExec (AdjustorExecutable addr)
1216 {
1217 AdjustorWritable writable;
1218 writable = *((void**)addr - 1);
1219 ACQUIRE_SM_LOCK;
1220 ffi_closure_free (writable);
1221 RELEASE_SM_LOCK
1222 }
1223
1224 #elif defined(ios_HOST_OS)
1225
1226 static HashTable* allocatedExecs;
1227
1228 AdjustorWritable allocateExec(W_ bytes, AdjustorExecutable *exec_ret)
1229 {
1230 AdjustorWritable writ;
1231 ffi_closure* cl;
1232 if (bytes != sizeof(ffi_closure)) {
1233 barf("allocateExec: for ffi_closure only");
1234 }
1235 ACQUIRE_SM_LOCK;
1236 cl = writ = ffi_closure_alloc((size_t)bytes, exec_ret);
1237 if (cl != NULL) {
1238 if (allocatedExecs == NULL) {
1239 allocatedExecs = allocHashTable();
1240 }
1241 insertHashTable(allocatedExecs, (StgWord)*exec_ret, writ);
1242 }
1243 RELEASE_SM_LOCK;
1244 return writ;
1245 }
1246
1247 AdjustorWritable execToWritable(AdjustorExecutable exec)
1248 {
1249 AdjustorWritable writ;
1250 ACQUIRE_SM_LOCK;
1251 if (allocatedExecs == NULL ||
1252 (writ = lookupHashTable(allocatedExecs, (StgWord)exec)) == NULL) {
1253 RELEASE_SM_LOCK;
1254 barf("execToWritable: not found");
1255 }
1256 RELEASE_SM_LOCK;
1257 return writ;
1258 }
1259
1260 void freeExec(AdjustorExecutable exec)
1261 {
1262 AdjustorWritable writ;
1263 ffi_closure* cl;
1264 cl = writ = execToWritable(exec);
1265 ACQUIRE_SM_LOCK;
1266 removeHashTable(allocatedExecs, (StgWord)exec, writ);
1267 ffi_closure_free(cl);
1268 RELEASE_SM_LOCK
1269 }
1270
1271 #else
1272
1273 AdjustorWritable allocateExec (W_ bytes, AdjustorExecutable *exec_ret)
1274 {
1275 void *ret;
1276 W_ n;
1277
1278 ACQUIRE_SM_LOCK;
1279
1280 // round up to words.
1281 n = (bytes + sizeof(W_) + 1) / sizeof(W_);
1282
1283 if (n+1 > BLOCK_SIZE_W) {
1284 barf("allocateExec: can't handle large objects");
1285 }
1286
1287 if (exec_block == NULL ||
1288 exec_block->free + n + 1 > exec_block->start + BLOCK_SIZE_W) {
1289 bdescr *bd;
1290 W_ pagesize = getPageSize();
1291 bd = allocGroup(stg_max(1, pagesize / BLOCK_SIZE));
1292 debugTrace(DEBUG_gc, "allocate exec block %p", bd->start);
1293 bd->gen_no = 0;
1294 bd->flags = BF_EXEC;
1295 bd->link = exec_block;
1296 if (exec_block != NULL) {
1297 exec_block->u.back = bd;
1298 }
1299 bd->u.back = NULL;
1300 setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsTrue);
1301 exec_block = bd;
1302 }
1303 *(exec_block->free) = n; // store the size of this chunk
1304 exec_block->gen_no += n; // gen_no stores the number of words allocated
1305 ret = exec_block->free + 1;
1306 exec_block->free += n + 1;
1307
1308 RELEASE_SM_LOCK
1309 *exec_ret = ret;
1310 return ret;
1311 }
1312
1313 void freeExec (void *addr)
1314 {
1315 StgPtr p = (StgPtr)addr - 1;
1316 bdescr *bd = Bdescr((StgPtr)p);
1317
1318 if ((bd->flags & BF_EXEC) == 0) {
1319 barf("freeExec: not executable");
1320 }
1321
1322 if (*(StgPtr)p == 0) {
1323 barf("freeExec: already free?");
1324 }
1325
1326 ACQUIRE_SM_LOCK;
1327
1328 bd->gen_no -= *(StgPtr)p;
1329 *(StgPtr)p = 0;
1330
1331 if (bd->gen_no == 0) {
1332 // Free the block if it is empty, but not if it is the block at
1333 // the head of the queue.
1334 if (bd != exec_block) {
1335 debugTrace(DEBUG_gc, "free exec block %p", bd->start);
1336 dbl_link_remove(bd, &exec_block);
1337 setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse);
1338 freeGroup(bd);
1339 } else {
1340 bd->free = bd->start;
1341 }
1342 }
1343
1344 RELEASE_SM_LOCK
1345 }
1346
1347 #endif /* switch(HOST_OS) */
1348
1349 #ifdef DEBUG
1350
1351 // handy function for use in gdb, because Bdescr() is inlined.
1352 extern bdescr *_bdescr (StgPtr p);
1353
1354 bdescr *
1355 _bdescr (StgPtr p)
1356 {
1357 return Bdescr(p);
1358 }
1359
1360 #endif