1
/* -----------------------------------------------------------------------------
3
* (c) The GHC Team, 1998-2008
5
* Storage manager front end
7
* Documentation on the architecture of the Storage Manager can be
8
* found in the online commentary:
10
* http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage
12
* ---------------------------------------------------------------------------*/
14
#include "PosixSource.h"
20
#include "BlockAlloc.h"
24
#include "Capability.h"
26
#include "RetainerProfile.h" // for counting memory blocks (memInventory)
37
* All these globals require sm_mutex to access in THREADED_RTS mode.
39
StgClosure *caf_list = NULL;
40
StgClosure *revertible_caf_list = NULL;
43
nat alloc_blocks_lim; /* GC if n_large_blocks in any nursery
48
generation *generations = NULL; /* all the generations */
49
generation *g0 = NULL; /* generation 0, for convenience */
50
generation *oldest_gen = NULL; /* oldest generation, for convenience */
52
nursery *nurseries = NULL; /* array of nurseries, size == n_capabilities */
56
* Storage manager mutex: protects all the above state from
57
* simultaneous access by two STG threads.
62
static void allocNurseries ( void );
65
initGeneration (generation *gen, int g)
69
gen->par_collections = 0;
70
gen->failed_promotions = 0;
75
gen->live_estimate = 0;
76
gen->old_blocks = NULL;
77
gen->n_old_blocks = 0;
78
gen->large_objects = NULL;
79
gen->n_large_blocks = 0;
80
gen->n_new_large_blocks = 0;
81
gen->mut_list = allocBlock();
82
gen->scavenged_large_objects = NULL;
83
gen->n_scavenged_large_blocks = 0;
88
initSpinLock(&gen->sync_large_objects);
90
gen->threads = END_TSO_QUEUE;
91
gen->old_threads = END_TSO_QUEUE;
99
if (generations != NULL) {
100
// multi-init protection
106
/* Sanity check to make sure the LOOKS_LIKE_ macros appear to be
107
* doing something reasonable.
109
/* We use the NOT_NULL variant or gcc warns that the test is always true */
110
ASSERT(LOOKS_LIKE_INFO_PTR_NOT_NULL((StgWord)&stg_BLOCKING_QUEUE_CLEAN_info));
111
ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure));
112
ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure));
114
if (RtsFlags.GcFlags.maxHeapSize != 0 &&
115
RtsFlags.GcFlags.heapSizeSuggestion >
116
RtsFlags.GcFlags.maxHeapSize) {
117
RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
120
if (RtsFlags.GcFlags.maxHeapSize != 0 &&
121
RtsFlags.GcFlags.minAllocAreaSize >
122
RtsFlags.GcFlags.maxHeapSize) {
123
errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
124
RtsFlags.GcFlags.minAllocAreaSize = RtsFlags.GcFlags.maxHeapSize;
127
initBlockAllocator();
129
#if defined(THREADED_RTS)
130
initMutex(&sm_mutex);
135
/* allocate generation info array */
136
generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations
137
* sizeof(struct generation_),
138
"initStorage: gens");
140
/* Initialise all generations */
141
for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
142
initGeneration(&generations[g], g);
145
/* A couple of convenience pointers */
146
g0 = &generations[0];
147
oldest_gen = &generations[RtsFlags.GcFlags.generations-1];
149
nurseries = stgMallocBytes(n_capabilities * sizeof(struct nursery_),
150
"initStorage: nurseries");
152
/* Set up the destination pointers in each younger gen. step */
153
for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
154
generations[g].to = &generations[g+1];
156
oldest_gen->to = oldest_gen;
158
/* The oldest generation has one step. */
159
if (RtsFlags.GcFlags.compact || RtsFlags.GcFlags.sweep) {
160
if (RtsFlags.GcFlags.generations == 1) {
161
errorBelch("WARNING: compact/sweep is incompatible with -G1; disabled");
163
oldest_gen->mark = 1;
164
if (RtsFlags.GcFlags.compact)
165
oldest_gen->compact = 1;
169
generations[0].max_blocks = 0;
171
/* The allocation area. Policy: keep the allocation area
172
* small to begin with, even if we have a large suggested heap
173
* size. Reason: we're going to do a major collection first, and we
174
* don't want it to be a big one. This vague idea is borne out by
175
* rigorous experimental evidence.
179
weak_ptr_list = NULL;
180
caf_list = END_OF_STATIC_LIST;
181
revertible_caf_list = END_OF_STATIC_LIST;
183
/* initialise the allocate() interface */
184
alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
189
initSpinLock(&gc_alloc_block_sync);
195
// allocate a block for each mut list
196
for (n = 0; n < n_capabilities; n++) {
197
for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
198
capabilities[n].mut_lists[g] = allocBlock();
204
IF_DEBUG(gc, statDescribeGens());
212
stat_exit(calcAllocated());
216
freeStorage (rtsBool free_heap)
218
stgFree(generations);
219
if (free_heap) freeAllMBlocks();
220
#if defined(THREADED_RTS)
221
closeMutex(&sm_mutex);
227
/* -----------------------------------------------------------------------------
230
The entry code for every CAF does the following:
232
- builds a BLACKHOLE in the heap
233
- pushes an update frame pointing to the BLACKHOLE
234
- calls newCaf, below
235
- updates the CAF with a static indirection to the BLACKHOLE
237
Why do we build an BLACKHOLE in the heap rather than just updating
238
the thunk directly? It's so that we only need one kind of update
239
frame - otherwise we'd need a static version of the update frame too.
241
newCaf() does the following:
243
- it puts the CAF on the oldest generation's mutable list.
244
This is so that we treat the CAF as a root when collecting
247
For GHCI, we have additional requirements when dealing with CAFs:
249
- we must *retain* all dynamically-loaded CAFs ever entered,
250
just in case we need them again.
251
- we must be able to *revert* CAFs that have been evaluated, to
252
their pre-evaluated form.
254
To do this, we use an additional CAF list. When newCaf() is
255
called on a dynamically-loaded CAF, we add it to the CAF list
256
instead of the old-generation mutable list, and save away its
257
old info pointer (in caf->saved_info) for later reversion.
259
To revert all the CAFs, we traverse the CAF list and reset the
260
info pointer to caf->saved_info, then throw away the CAF list.
261
(see GC.c:revertCAFs()).
265
-------------------------------------------------------------------------- */
268
newCAF(StgRegTable *reg, StgClosure* caf)
273
// If we are in GHCi _and_ we are using dynamic libraries,
274
// then we can't redirect newCAF calls to newDynCAF (see below),
275
// so we make newCAF behave almost like newDynCAF.
276
// The dynamic libraries might be used by both the interpreted
277
// program and GHCi itself, so they must not be reverted.
278
// This also means that in GHCi with dynamic libraries, CAFs are not
279
// garbage collected. If this turns out to be a problem, we could
280
// do another hack here and do an address range test on caf to figure
281
// out whether it is from a dynamic library.
282
((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info;
284
ACQUIRE_SM_LOCK; // caf_list is global, locked by sm_mutex
285
((StgIndStatic *)caf)->static_link = caf_list;
291
// Put this CAF on the mutable list for the old generation.
292
((StgIndStatic *)caf)->saved_info = NULL;
293
if (oldest_gen->no != 0) {
294
recordMutableCap(caf, regTableToCapability(reg), oldest_gen->no);
299
// External API for setting the keepCAFs flag. see #3900.
306
// An alternate version of newCaf which is used for dynamically loaded
307
// object code in GHCi. In this case we want to retain *all* CAFs in
308
// the object code, because they might be demanded at any time from an
309
// expression evaluated on the command line.
310
// Also, GHCi might want to revert CAFs, so we add these to the
311
// revertible_caf_list.
313
// The linker hackily arranges that references to newCaf from dynamic
314
// code end up pointing to newDynCAF.
316
newDynCAF (StgRegTable *reg STG_UNUSED, StgClosure *caf)
320
((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info;
321
((StgIndStatic *)caf)->static_link = revertible_caf_list;
322
revertible_caf_list = caf;
327
/* -----------------------------------------------------------------------------
329
-------------------------------------------------------------------------- */
332
allocNursery (bdescr *tail, nat blocks)
337
// We allocate the nursery as a single contiguous block and then
338
// divide it into single blocks manually. This way we guarantee
339
// that the nursery blocks are adjacent, so that the processor's
340
// automatic prefetching works across nursery blocks. This is a
341
// tiny optimisation (~0.5%), but it's free.
344
n = stg_min(blocks, BLOCKS_PER_MBLOCK);
348
for (i = 0; i < n; i++) {
349
initBdescr(&bd[i], g0, g0);
355
bd[i].u.back = &bd[i-1];
361
bd[i].link = &bd[i+1];
365
tail->u.back = &bd[i];
369
bd[i].free = bd[i].start;
379
assignNurseriesToCapabilities (void)
383
for (i = 0; i < n_capabilities; i++) {
384
capabilities[i].r.rNursery = &nurseries[i];
385
capabilities[i].r.rCurrentNursery = nurseries[i].blocks;
386
capabilities[i].r.rCurrentAlloc = NULL;
391
allocNurseries( void )
395
for (i = 0; i < n_capabilities; i++) {
396
nurseries[i].blocks =
397
allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
398
nurseries[i].n_blocks =
399
RtsFlags.GcFlags.minAllocAreaSize;
401
assignNurseriesToCapabilities();
405
resetNurseries( void )
410
for (i = 0; i < n_capabilities; i++) {
411
for (bd = nurseries[i].blocks; bd; bd = bd->link) {
412
bd->free = bd->start;
413
ASSERT(bd->gen_no == 0);
414
ASSERT(bd->gen == g0);
415
IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
418
assignNurseriesToCapabilities();
422
countNurseryBlocks (void)
427
for (i = 0; i < n_capabilities; i++) {
428
blocks += nurseries[i].n_blocks;
434
resizeNursery ( nursery *nursery, nat blocks )
439
nursery_blocks = nursery->n_blocks;
440
if (nursery_blocks == blocks) return;
442
if (nursery_blocks < blocks) {
443
debugTrace(DEBUG_gc, "increasing size of nursery to %d blocks",
445
nursery->blocks = allocNursery(nursery->blocks, blocks-nursery_blocks);
450
debugTrace(DEBUG_gc, "decreasing size of nursery to %d blocks",
453
bd = nursery->blocks;
454
while (nursery_blocks > blocks) {
456
next_bd->u.back = NULL;
457
nursery_blocks -= bd->blocks; // might be a large block
461
nursery->blocks = bd;
462
// might have gone just under, by freeing a large block, so make
463
// up the difference.
464
if (nursery_blocks < blocks) {
465
nursery->blocks = allocNursery(nursery->blocks, blocks-nursery_blocks);
469
nursery->n_blocks = blocks;
470
ASSERT(countBlocks(nursery->blocks) == nursery->n_blocks);
474
// Resize each of the nurseries to the specified size.
477
resizeNurseriesFixed (nat blocks)
480
for (i = 0; i < n_capabilities; i++) {
481
resizeNursery(&nurseries[i], blocks);
486
// Resize the nurseries to the total specified size.
489
resizeNurseries (nat blocks)
491
// If there are multiple nurseries, then we just divide the number
492
// of available blocks between them.
493
resizeNurseriesFixed(blocks / n_capabilities);
497
/* -----------------------------------------------------------------------------
498
move_TSO is called to update the TSO structure after it has been
499
moved from one place to another.
500
-------------------------------------------------------------------------- */
503
move_TSO (StgTSO *src, StgTSO *dest)
507
// relocate the stack pointer...
508
diff = (StgPtr)dest - (StgPtr)src; // In *words*
509
dest->sp = (StgPtr)dest->sp + diff;
512
/* -----------------------------------------------------------------------------
513
split N blocks off the front of the given bdescr, returning the
514
new block group. We add the remainder to the large_blocks list
515
in the same step as the original block.
516
-------------------------------------------------------------------------- */
519
splitLargeBlock (bdescr *bd, nat blocks)
525
ASSERT(countBlocks(bd->gen->large_objects) == bd->gen->n_large_blocks);
527
// subtract the original number of blocks from the counter first
528
bd->gen->n_large_blocks -= bd->blocks;
530
new_bd = splitBlockGroup (bd, blocks);
531
initBdescr(new_bd, bd->gen, bd->gen->to);
532
new_bd->flags = BF_LARGE | (bd->flags & BF_EVACUATED);
533
// if new_bd is in an old generation, we have to set BF_EVACUATED
534
new_bd->free = bd->free;
535
dbl_link_onto(new_bd, &bd->gen->large_objects);
537
ASSERT(new_bd->free <= new_bd->start + new_bd->blocks * BLOCK_SIZE_W);
539
// add the new number of blocks to the counter. Due to the gaps
540
// for block descriptors, new_bd->blocks + bd->blocks might not be
541
// equal to the original bd->blocks, which is why we do it this way.
542
bd->gen->n_large_blocks += bd->blocks + new_bd->blocks;
544
ASSERT(countBlocks(bd->gen->large_objects) == bd->gen->n_large_blocks);
551
/* -----------------------------------------------------------------------------
554
This allocates memory in the current thread - it is intended for
555
use primarily from STG-land where we have a Capability. It is
556
better than allocate() because it doesn't require taking the
557
sm_mutex lock in the common case.
559
Memory is allocated directly from the nursery if possible (but not
560
from the current nursery block, so as not to interfere with
562
-------------------------------------------------------------------------- */
565
allocate (Capability *cap, lnat n)
570
if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
571
lnat req_blocks = (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
573
// Attempting to allocate an object larger than maxHeapSize
574
// should definitely be disallowed. (bug #1791)
575
if (RtsFlags.GcFlags.maxHeapSize > 0 &&
576
req_blocks >= RtsFlags.GcFlags.maxHeapSize) {
578
// heapOverflow() doesn't exit (see #2592), but we aren't
579
// in a position to do a clean shutdown here: we
580
// either have to allocate the memory or exit now.
581
// Allocating the memory would be bad, because the user
582
// has requested that we not exceed maxHeapSize, so we
584
stg_exit(EXIT_HEAPOVERFLOW);
588
bd = allocGroup(req_blocks);
589
dbl_link_onto(bd, &g0->large_objects);
590
g0->n_large_blocks += bd->blocks; // might be larger than req_blocks
591
g0->n_new_large_blocks += bd->blocks;
593
initBdescr(bd, g0, g0);
594
bd->flags = BF_LARGE;
595
bd->free = bd->start + n;
599
/* small allocation (<LARGE_OBJECT_THRESHOLD) */
601
TICK_ALLOC_HEAP_NOCTR(n);
604
bd = cap->r.rCurrentAlloc;
605
if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
607
// The CurrentAlloc block is full, we need to find another
608
// one. First, we try taking the next block from the
610
bd = cap->r.rCurrentNursery->link;
612
if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
613
// The nursery is empty, or the next block is already
614
// full: allocate a fresh block (we can't fail here).
617
cap->r.rNursery->n_blocks++;
619
initBdescr(bd, g0, g0);
621
// If we had to allocate a new block, then we'll GC
622
// pretty quickly now, because MAYBE_GC() will
623
// notice that CurrentNursery->link is NULL.
625
// we have a block in the nursery: take it and put
626
// it at the *front* of the nursery list, and use it
627
// to allocate() from.
628
cap->r.rCurrentNursery->link = bd->link;
629
if (bd->link != NULL) {
630
bd->link->u.back = cap->r.rCurrentNursery;
633
dbl_link_onto(bd, &cap->r.rNursery->blocks);
634
cap->r.rCurrentAlloc = bd;
635
IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
640
IF_DEBUG(sanity, ASSERT(*((StgWord8*)p) == 0xaa));
644
/* ---------------------------------------------------------------------------
645
Allocate a fixed/pinned object.
647
We allocate small pinned objects into a single block, allocating a
648
new block when the current one overflows. The block is chained
649
onto the large_object_list of generation 0.
651
NOTE: The GC can't in general handle pinned objects. This
652
interface is only safe to use for ByteArrays, which have no
653
pointers and don't require scavenging. It works because the
654
block's descriptor has the BF_LARGE flag set, so the block is
655
treated as a large object and chained onto various lists, rather
656
than the individual objects being copied. However, when it comes
657
to scavenge the block, the GC will only scavenge the first object.
658
The reason is that the GC can't linearly scan a block of pinned
659
objects at the moment (doing so would require using the
660
mostly-copying techniques). But since we're restricting ourselves
661
to pinned ByteArrays, not scavenging is ok.
663
This function is called by newPinnedByteArray# which immediately
664
fills the allocated memory with a MutableByteArray#.
665
------------------------------------------------------------------------- */
668
allocatePinned (Capability *cap, lnat n)
673
// If the request is for a large object, then allocate()
674
// will give us a pinned object anyway.
675
if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
676
p = allocate(cap, n);
677
Bdescr(p)->flags |= BF_PINNED;
681
TICK_ALLOC_HEAP_NOCTR(n);
684
bd = cap->pinned_object_block;
686
// If we don't have a block of pinned objects yet, or the current
687
// one isn't large enough to hold the new object, allocate a new one.
688
if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) {
690
cap->pinned_object_block = bd = allocBlock();
691
dbl_link_onto(bd, &g0->large_objects);
692
g0->n_large_blocks++;
693
g0->n_new_large_blocks++;
695
initBdescr(bd, g0, g0);
696
bd->flags = BF_PINNED | BF_LARGE;
697
bd->free = bd->start;
705
/* -----------------------------------------------------------------------------
707
-------------------------------------------------------------------------- */
710
This is the write barrier for MUT_VARs, a.k.a. IORefs. A
711
MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
712
is. When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
713
and is put on the mutable list.
716
dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
718
Capability *cap = regTableToCapability(reg);
719
if (p->header.info == &stg_MUT_VAR_CLEAN_info) {
720
p->header.info = &stg_MUT_VAR_DIRTY_info;
721
recordClosureMutated(cap,p);
725
// Setting a TSO's link field with a write barrier.
726
// It is *not* necessary to call this function when
727
// * setting the link field to END_TSO_QUEUE
728
// * putting a TSO on the blackhole_queue
729
// * setting the link field of the currently running TSO, as it
730
// will already be dirty.
732
setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target)
734
if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
735
tso->flags |= TSO_LINK_DIRTY;
736
recordClosureMutated(cap,(StgClosure*)tso);
742
setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target)
744
if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
745
tso->flags |= TSO_LINK_DIRTY;
746
recordClosureMutated(cap,(StgClosure*)tso);
748
tso->block_info.prev = target;
752
dirty_TSO (Capability *cap, StgTSO *tso)
754
if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
755
recordClosureMutated(cap,(StgClosure*)tso);
761
This is the write barrier for MVARs. An MVAR_CLEAN objects is not
762
on the mutable list; a MVAR_DIRTY is. When written to, a
763
MVAR_CLEAN turns into a MVAR_DIRTY and is put on the mutable list.
764
The check for MVAR_CLEAN is inlined at the call site for speed,
765
this really does make a difference on concurrency-heavy benchmarks
766
such as Chaneneos and cheap-concurrency.
769
dirty_MVAR(StgRegTable *reg, StgClosure *p)
771
recordClosureMutated(regTableToCapability(reg),p);
774
/* -----------------------------------------------------------------------------
776
* -------------------------------------------------------------------------- */
778
/* -----------------------------------------------------------------------------
781
* Approximate how much we've allocated: number of blocks in the
782
* nursery + blocks allocated via allocate() - unused nusery blocks.
783
* This leaves a little slop at the end of each block.
784
* -------------------------------------------------------------------------- */
787
calcAllocated( void )
793
allocated = countNurseryBlocks() * BLOCK_SIZE_W;
795
for (i = 0; i < n_capabilities; i++) {
797
for ( bd = capabilities[i].r.rCurrentNursery->link;
798
bd != NULL; bd = bd->link ) {
799
allocated -= BLOCK_SIZE_W;
801
cap = &capabilities[i];
802
if (cap->r.rCurrentNursery->free <
803
cap->r.rCurrentNursery->start + BLOCK_SIZE_W) {
804
allocated -= (cap->r.rCurrentNursery->start + BLOCK_SIZE_W)
805
- cap->r.rCurrentNursery->free;
807
if (cap->pinned_object_block != NULL) {
808
allocated -= (cap->pinned_object_block->start + BLOCK_SIZE_W) -
809
cap->pinned_object_block->free;
813
allocated += g0->n_new_large_blocks * BLOCK_SIZE_W;
818
/* Approximate the amount of live data in the heap. To be called just
819
* after garbage collection (see GarbageCollect()).
821
lnat calcLiveBlocks (void)
827
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
828
/* approximate amount of live data (doesn't take into account slop
829
* at end of each block).
831
gen = &generations[g];
832
live += gen->n_large_blocks + gen->n_blocks;
837
lnat countOccupied (bdescr *bd)
842
for (; bd != NULL; bd = bd->link) {
843
ASSERT(bd->free <= bd->start + bd->blocks * BLOCK_SIZE_W);
844
words += bd->free - bd->start;
849
// Return an accurate count of the live data in the heap, excluding
851
lnat calcLiveWords (void)
858
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
859
gen = &generations[g];
860
live += gen->n_words + countOccupied(gen->large_objects);
865
/* Approximate the number of blocks that will be needed at the next
866
* garbage collection.
868
* Assume: all data currently live will remain live. Generationss
869
* that will be collected next time will therefore need twice as many
870
* blocks since all the data will be copied.
879
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
880
gen = &generations[g];
882
// we need at least this much space
883
needed += gen->n_blocks + gen->n_large_blocks;
885
// any additional space needed to collect this gen next time?
886
if (g == 0 || // always collect gen 0
887
(gen->n_blocks + gen->n_large_blocks > gen->max_blocks)) {
888
// we will collect this gen next time
891
needed += gen->n_blocks / BITS_IN(W_);
893
needed += gen->n_blocks / 100;
896
continue; // no additional space needed for compaction
898
needed += gen->n_blocks;
905
/* ----------------------------------------------------------------------------
908
Executable memory must be managed separately from non-executable
909
memory. Most OSs these days require you to jump through hoops to
910
dynamically allocate executable memory, due to various security
913
Here we provide a small memory allocator for executable memory.
914
Memory is managed with a page granularity; we allocate linearly
915
in the page, and when the page is emptied (all objects on the page
916
are free) we free the page again, not forgetting to make it
919
TODO: The inability to handle objects bigger than BLOCK_SIZE_W means that
920
the linker cannot use allocateExec for loading object code files
921
on Windows. Once allocateExec can handle larger objects, the linker
922
should be modified to use allocateExec instead of VirtualAlloc.
923
------------------------------------------------------------------------- */
925
#if defined(linux_HOST_OS)
927
// On Linux we need to use libffi for allocating executable memory,
928
// because it knows how to work around the restrictions put in place
931
void *allocateExec (nat bytes, void **exec_ret)
935
ret = ffi_closure_alloc (sizeof(void *) + (size_t)bytes, (void**)&exec);
937
if (ret == NULL) return ret;
938
*ret = ret; // save the address of the writable mapping, for freeExec().
939
*exec_ret = exec + 1;
943
// freeExec gets passed the executable address, not the writable address.
944
void freeExec (void *addr)
947
writable = *((void**)addr - 1);
949
ffi_closure_free (writable);
955
void *allocateExec (nat bytes, void **exec_ret)
962
// round up to words.
963
n = (bytes + sizeof(W_) + 1) / sizeof(W_);
965
if (n+1 > BLOCK_SIZE_W) {
966
barf("allocateExec: can't handle large objects");
969
if (exec_block == NULL ||
970
exec_block->free + n + 1 > exec_block->start + BLOCK_SIZE_W) {
972
lnat pagesize = getPageSize();
973
bd = allocGroup(stg_max(1, pagesize / BLOCK_SIZE));
974
debugTrace(DEBUG_gc, "allocate exec block %p", bd->start);
977
bd->link = exec_block;
978
if (exec_block != NULL) {
979
exec_block->u.back = bd;
982
setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsTrue);
985
*(exec_block->free) = n; // store the size of this chunk
986
exec_block->gen_no += n; // gen_no stores the number of words allocated
987
ret = exec_block->free + 1;
988
exec_block->free += n + 1;
995
void freeExec (void *addr)
997
StgPtr p = (StgPtr)addr - 1;
998
bdescr *bd = Bdescr((StgPtr)p);
1000
if ((bd->flags & BF_EXEC) == 0) {
1001
barf("freeExec: not executable");
1004
if (*(StgPtr)p == 0) {
1005
barf("freeExec: already free?");
1010
bd->gen_no -= *(StgPtr)p;
1013
if (bd->gen_no == 0) {
1014
// Free the block if it is empty, but not if it is the block at
1015
// the head of the queue.
1016
if (bd != exec_block) {
1017
debugTrace(DEBUG_gc, "free exec block %p", bd->start);
1018
dbl_link_remove(bd, &exec_block);
1019
setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse);
1022
bd->free = bd->start;
1029
#endif /* mingw32_HOST_OS */
1033
// handy function for use in gdb, because Bdescr() is inlined.
1034
extern bdescr *_bdescr( StgPtr p );
added
removed
rts/sm/Storage.c
