← Back to branch summary

~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to erts/emulator/beam/erl_gc.c

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
erts/emulator/beam/erl_gc.c
25
25
#include "erl_process.h"
26
26
#include "erl_db.h"
27
27
#include "beam_catches.h"
 
28
#include "erl_binary.h"
 
29
#include "erl_bits.h"
 
30
#include "erl_nmgc.h"
 
31
#include "error.h"
 
32
#include "big.h"
28
33
 
29
34
/*
30
35
 * Returns number of elements in an array.
31
36
 */
32
37
#define ALENGTH(a) (sizeof(a)/sizeof(a[0]))
33
38
 
34
 
#if defined(__GNUC__)
35
 
#  define INLINE __inline__
36
 
#elif defined(__WIN32__)
37
 
#  define INLINE __inline
38
 
#else
39
 
#  define INLINE
 
39
#ifdef HEAP_FRAG_ELIM_TEST
 
40
 
 
41
#ifdef DEBUG
 
42
#  define HARDDEBUG 1
40
43
#endif
41
44
 
42
 
#ifdef HEAP_FRAG_ELIM_TEST
 
45
static erts_smp_spinlock_t info_lck;
 
46
static Uint garbage_cols;               /* no of garbage collections */
 
47
static Uint reclaimed;                  /* no of words reclaimed in GCs */
43
48
 
44
49
#define IS_MOVED(x)     (!is_header((x)))
45
50
 
75
80
        *HTOP++ = *PTR++;                                               \
76
81
} while(0)
77
82
 
78
 
#define UPDATE_SSB(p,HDR,HTOP)                                  \
79
 
do {                                                            \
80
 
    if (((HDR) & _HEADER_SUBTAG_MASK) == VECTOR_SUBTAG) {       \
81
 
        Uint n = header_arity(HDR);                             \
82
 
        Eterm* hp = HTOP;                                       \
83
 
        erts_ensure_ssb(p);                                     \
84
 
        while (n--) {                                           \
85
 
            hp--;                                               \
86
 
            if (is_not_immed(*hp)) {                            \
87
 
                ERTS_SSB_PUT(p, hp);                            \
88
 
            }                                                   \
89
 
        }                                                       \
90
 
    }                                                           \
91
 
} while(0)
92
 
 
93
83
#define in_area(ptr,start,nbytes) \
94
84
 ((unsigned long)((char*)(ptr) - (char*)(start)) < (nbytes))
95
85
 
96
 
#ifdef SHARED_HEAP
97
 
# define STACK_SZ_ON_HEAP(p) 0
98
 
# define OverRunCheck() \
99
 
    if (HEAP_END(p) < HEAP_TOP(p)) { \
100
 
        erl_exit(1, "%s: Overrun heap at line %d\n", print_pid(p),__LINE__); \
101
 
    }
102
 
#else
103
86
# define STACK_SZ_ON_HEAP(p) ((p)->hend - (p)->stop)
104
87
# define OverRunCheck() \
105
88
    if (p->stop < p->htop) { \
106
 
        erl_exit(1, "%s: Overrun stack and heap at line %d\n", print_pid(p),__LINE__); \
 
89
        erl_exit(1, "%T: Overrun stack and heap at line %d\n", p->id,__LINE__); \
107
90
    }
108
 
#endif
109
91
 
110
92
/*
111
93
 * This structure describes the rootset for the GC.
126
108
static Uint setup_rootset(Process*, Eterm*, int, Rootset*);
127
109
static void cleanup_rootset(Rootset *rootset);
128
110
static void remove_message_buffers(Process* p);
129
 
static int major_collection(Process* p, int need, Eterm* objv, int nobj);
130
 
static int minor_collection(Process* p, int need, Eterm* objv, int nobj);
 
111
static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl);
 
112
static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl);
131
113
static void do_minor(Process *p, int new_sz, Eterm* objv, int nobj);
132
114
static Eterm* sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size);
133
115
static Eterm* sweep_old_heap(Process* p, Eterm* n_hp, Eterm* n_htop,
134
116
                             char* src, Uint src_size);
135
117
static Eterm* collect_heap_frags(Process* p, Eterm* heap,
136
118
                                 Eterm* htop, Eterm* objv, int nobj);
137
 
static void adjust_after_fullsweep(Process *p, int size_before,
 
119
static Uint adjust_after_fullsweep(Process *p, int size_before,
138
120
                                   int need, Eterm *objv, int nobj);
139
121
static void grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj);
140
 
static void shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj);
141
122
static void sweep_proc_bins(Process *p, int fullsweep);
142
 
#ifndef SHARED_HEAP
143
123
static void sweep_proc_funs(Process *p, int fullsweep);
144
 
#endif
145
124
static void sweep_proc_externals(Process *p, int fullsweep);
146
125
static void offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size);
147
126
static void offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size);
148
 
static void offset_rootset(Process *p, int offs, char* area, Uint area_size,
 
127
static void offset_rootset(Process *p, Sint offs, char* area, Uint area_size,
149
128
                           Eterm* objv, int nobj);
150
 
static void offset_off_heap(Process* p, int offs, char* area, Uint area_size);
 
129
static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size);
151
130
static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size);
152
 
static char* print_pid(Process *p);
153
131
#ifdef DEBUG
154
132
static int within(Eterm *ptr, Process *p);
155
 
void verify_old_heap(Process* p);
156
133
#endif
157
 
static void ssb_filter(Process* p);
158
134
#endif /* HEAP_FRAG_ELIM_TEST */
159
135
 
160
 
static int heap_sizes[64];      /* Suitable heap sizes. */
 
136
#ifdef HARDDEBUG
 
137
static void disallow_heap_frag_ref_in_heap(Process* p);
 
138
static void disallow_heap_frag_ref_in_old_heap(Process* p);
 
139
static void disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj);
 
140
#endif
 
141
 
 
142
#ifdef ARCH_64
 
143
# define MAX_HEAP_SIZES 154
 
144
#else
 
145
# define MAX_HEAP_SIZES 55
 
146
#endif
 
147
 
 
148
static Sint heap_sizes[MAX_HEAP_SIZES]; /* Suitable heap sizes. */
161
149
static int num_heap_sizes;      /* Number of heap sizes. */
162
150
 
 
151
 
 
152
#ifndef HEAP_FRAG_ELIM_TEST
 
153
extern void erts_init_ggc(void);
 
154
#endif
 
155
 
163
156
/*
164
157
 * Initialize GC global data.
165
158
 */
168
161
{
169
162
    int i = 0;
170
163
 
171
 
    switch (heap_series) {
172
 
    case HS_FIBONACCI:
173
 
        heap_sizes[0] = 34;
174
 
        heap_sizes[1] = 55;
175
 
        for (i = 2; i < ALENGTH(heap_sizes) && heap_sizes[i-1] < MAX_SMALL; i++) {
176
 
            heap_sizes[i] = heap_sizes[i-1] + heap_sizes[i-2];
177
 
        }
178
 
        break;
179
 
 
180
 
    case HS_FIBONACCI_SLOW:
181
 
        {
182
 
            /*
183
 
             * Fib growth is not really ok for really large heaps, for
184
 
             * example is fib(35) == 14meg, whereas fib(36) == 24meg,
185
 
             * we really don't want that growth when the heaps are that big.
186
 
             */
187
 
            
188
 
            double grow_factor = 1.25;  /* instead of fib */
189
 
            
190
 
            heap_sizes[0] = 34;
191
 
            heap_sizes[1] = 55;
192
 
            for (i = 2; i < 23; i++) {
193
 
                heap_sizes[i] = heap_sizes[i-1] + heap_sizes[i-2];
194
 
            }
195
 
            
196
 
            /* At 1.3 mega words heap, we start to slow down */
197
 
            for (i = 23; i < ALENGTH(heap_sizes) && heap_sizes[i-1] < MAX_SMALL; i++) {
198
 
                heap_sizes[i] = (int) (grow_factor * heap_sizes[i-1]);
199
 
            }
200
 
        }
201
 
        break;
202
 
    case HS_POWER_TWO:
203
 
        heap_sizes[0] = 32;
204
 
        for (i = 1; i < ALENGTH(heap_sizes) && heap_sizes[i-1] < MAX_SMALL; i++) {
205
 
            heap_sizes[i] = 2 * heap_sizes[i-1];
206
 
        }
207
 
        break;
208
 
    case HS_POWER_TWO_MINUS_ONE:
209
 
        heap_sizes[0] = 31;
210
 
        for (i = 1; i < ALENGTH(heap_sizes) && heap_sizes[i-1] < MAX_SMALL; i++) {
211
 
            heap_sizes[i] = 2 * (heap_sizes[i-1]+1) - 1;
212
 
        }
213
 
        break;
 
164
#ifdef HEAP_FRAG_ELIM_TEST
 
165
    erts_smp_spinlock_init(&info_lck, "gc_info");
 
166
    garbage_cols = 0;
 
167
    reclaimed = 0;
 
168
#else
 
169
    erts_init_ggc();
 
170
#endif
 
171
 
 
172
    /*
 
173
     * Heap sizes start growing in a Fibonacci sequence.
 
174
     *
 
175
     * Fib growth is not really ok for really large heaps, for
 
176
     * example is fib(35) == 14meg, whereas fib(36) == 24meg;
 
177
     * we really don't want that growth when the heaps are that big.
 
178
     */
 
179
            
 
180
    heap_sizes[0] = 34;
 
181
    heap_sizes[1] = 55;
 
182
    for (i = 2; i < 23; i++) {
 
183
        heap_sizes[i] = heap_sizes[i-1] + heap_sizes[i-2];
 
184
    }
 
185
 
 
186
    /* At 1.3 mega words heap, we start to slow down. */
 
187
    for (i = 23; i < ALENGTH(heap_sizes); i++) {
 
188
        heap_sizes[i] = 5*(heap_sizes[i-1]/4);
 
189
        if (heap_sizes[i] < 0) {
 
190
            /* Size turned negative. Discard this last size. */
 
191
            i--;
 
192
            break;
 
193
        }
214
194
    }
215
195
    num_heap_sizes = i;
216
196
}
226
206
    if (size < heap_sizes[0]) {
227
207
        return heap_sizes[0];
228
208
    } else {
229
 
        int* low = heap_sizes;
230
 
        int* high = heap_sizes + num_heap_sizes;
231
 
        int* mid;
 
209
        Sint* low = heap_sizes;
 
210
        Sint* high = heap_sizes + num_heap_sizes;
 
211
        Sint* mid;
232
212
 
233
213
        while (low < high) {
234
214
            mid = low + (high-low) / 2;
254
234
erts_heap_sizes(Process* p)
255
235
{
256
236
    int i;
 
237
    int n = 0;
 
238
    int big = 0;
257
239
    Eterm res = NIL;
258
 
    Eterm* hp = HAlloc(p, num_heap_sizes * 2);
259
 
 
260
 
    for (i = num_heap_sizes-1; i >= 0; i--) {
261
 
        res = CONS(hp, make_small(heap_sizes[i]), res);
 
240
    Eterm* hp;
 
241
    Eterm* bigp;
 
242
 
 
243
    for (i = num_heap_sizes-1; i >= 0; i--) {
 
244
        n += 2;
 
245
        if (!MY_IS_SSMALL(heap_sizes[i])) {
 
246
            big += BIG_UINT_HEAP_SIZE;
 
247
        }
 
248
    }
 
249
 
 
250
    /*
 
251
     * We store all big numbers first on the heap, followed
 
252
     * by all the cons cells.
 
253
     */
 
254
    bigp = HAlloc(p, n+big);
 
255
    hp = bigp+big;
 
256
    for (i = num_heap_sizes-1; i >= 0; i--) {
 
257
        Eterm num;
 
258
        Sint sz = heap_sizes[i];
 
259
 
 
260
        if (MY_IS_SSMALL(sz)) {
 
261
            num = make_small(sz);
 
262
        } else {
 
263
            num = uint_to_big(sz, bigp);
 
264
            bigp += BIG_UINT_HEAP_SIZE;
 
265
        }
 
266
        res = CONS(hp, num, res);
262
267
        hp += 2;
263
268
    }
264
269
    return res;
266
271
 
267
272
#ifdef HEAP_FRAG_ELIM_TEST
268
273
 
 
274
void
 
275
erts_gc_info(ErtsGCInfo *gcip)
 
276
{
 
277
    if (gcip) {
 
278
        erts_smp_spin_lock(&info_lck);
 
279
        gcip->garbage_collections = garbage_cols;
 
280
        gcip->reclaimed = reclaimed;
 
281
        erts_smp_spin_unlock(&info_lck);
 
282
    }
 
283
}
 
284
 
 
285
void 
 
286
erts_offset_heap(Eterm* hp, Uint sz, Sint offs, Eterm* low, Eterm* high)
 
287
{
 
288
    return offset_heap(hp, sz, offs, (char*) low, high-low);
 
289
}
 
290
 
 
291
void 
 
292
erts_offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, 
 
293
                     Eterm* low, Eterm* high)
 
294
{
 
295
    return offset_heap_ptr(hp, sz, offs, (char *) low, high-low);
 
296
}
 
297
 
 
298
#define ptr_within(ptr, low, high) ((ptr) < (high) && (ptr) >= (low))
 
299
 
 
300
void
 
301
erts_offset_off_heap(ErlOffHeap *ohp, Sint offs, Eterm* low, Eterm* high)
 
302
{
 
303
    if (ohp->mso && ptr_within((Eterm *)ohp->mso, low, high)) {
 
304
        Eterm** uptr = (Eterm**) &ohp->mso;
 
305
        *uptr += offs;
 
306
    }
 
307
 
 
308
#ifndef HYBRID /* FIND ME! */
 
309
    if (ohp->funs && ptr_within((Eterm *)ohp->funs, low, high)) {
 
310
        Eterm** uptr = (Eterm**) &ohp->funs;
 
311
        *uptr += offs;
 
312
    }
 
313
#endif
 
314
 
 
315
    if (ohp->externals && ptr_within((Eterm *)ohp->externals, low, high)) {
 
316
        Eterm** uptr = (Eterm**) &ohp->externals;
 
317
        *uptr += offs;
 
318
    }
 
319
}
 
320
#undef ptr_within
 
321
 
 
322
#if defined(HEAP_FRAG_ELIM_TEST)
 
323
Eterm
 
324
erts_gc_after_bif_call(Process* p, Eterm result)
 
325
{
 
326
    int cost;
 
327
 
 
328
    if (is_non_value(result)) {
 
329
        if (p->freason == TRAP) {
 
330
            cost = erts_garbage_collect(p, 0, p->def_arg_reg, p->arity);
 
331
        } else if (p->freason == RESCHEDULE) {
 
332
            abort();
 
333
        } else {
 
334
            cost = erts_garbage_collect(p, 0, NULL, 0);
 
335
        }
 
336
    } else {
 
337
        Eterm val[1];
 
338
 
 
339
        val[0] = result;
 
340
        cost = erts_garbage_collect(p, 0, val, 1);
 
341
        result = val[0];
 
342
    }
 
343
    BUMP_REDS(p, cost);
 
344
    return result;
 
345
}
 
346
#endif
 
347
 
269
348
/*
270
349
 * Garbage collect a process.
271
350
 *
277
356
int
278
357
erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
279
358
{
 
359
    Uint reclaimed_now = 0;
280
360
    int done = 0;
281
361
    Uint saved_status = p->status;
282
362
    Uint ms1, s1, us1;
286
366
        trace_gc(p, am_gc_start);
287
367
    }
288
368
    if (erts_system_monitor_long_gc != 0) get_now(&ms1, &s1, &us1);
289
 
    if (SAVED_HEAP_TOP(p) != NULL) {
290
 
        HEAP_TOP(p) = SAVED_HEAP_TOP(p);
291
 
        SAVED_HEAP_TOP(p) = NULL;
292
 
    }
293
369
    OverRunCheck();
294
370
    if (GEN_GCS(p) >= MAX_GEN_GCS(p)) {
295
371
        FLAGS(p) |= F_NEED_FULLSWEEP;
300
376
     */
301
377
    while (!done) {
302
378
        if ((FLAGS(p) & F_NEED_FULLSWEEP) != 0) {
303
 
            done = major_collection(p, need, objv, nobj);
 
379
            done = major_collection(p, need, objv, nobj, &reclaimed_now);
304
380
        } else {
305
 
            done = minor_collection(p, need, objv, nobj);
 
381
            done = minor_collection(p, need, objv, nobj, &reclaimed_now);
306
382
        }
307
383
    }
308
384
 
318
394
        t = t*1000000 + s2 - s1;
319
395
        t = t*1000 + (us2 - us1)/1000;
320
396
        if (t > 0 && (Uint)t > erts_system_monitor_long_gc) {
321
 
            monitor_gc(p, t);
 
397
            monitor_long_gc(p, t);
322
398
        }
323
399
    }
324
400
 
 
401
 
 
402
    erts_smp_spin_lock(&info_lck);
325
403
    garbage_cols++;
326
 
    ARITH_LOWEST_HTOP(p) = (Eterm *) 0;
327
 
    ARITH_AVAIL(p) = 0;
328
 
    ARITH_HEAP(p) = NULL;
 
404
    reclaimed += reclaimed_now;
 
405
    erts_smp_spin_unlock(&info_lck);
 
406
 
329
407
    MSO(p).overhead = 0;
330
 
#ifdef DEBUG
331
 
    ARITH_CHECK_ME(p) = NULL;
332
 
#endif
 
408
 
 
409
#ifdef CHECK_FOR_HOLES
 
410
    /*
 
411
     * We intentionally do not rescan the areas copied by the GC.
 
412
     * We trust the GC not to leave any holes.
 
413
     */
 
414
    {
 
415
        Eterm* start = p->htop;
 
416
        Eterm* stop = p->stop;
 
417
        p->last_htop = p->htop;
 
418
        p->last_mbuf = 0;
 
419
        while (start < stop) {
 
420
            *start++ = ERTS_HOLE_MARKER;
 
421
        }
 
422
    }
 
423
#endif    
 
424
 
333
425
    return ((int) (HEAP_TOP(p) - HEAP_START(p)) / 10);
334
426
}
335
427
 
336
428
static int
337
 
minor_collection(Process* p, int need, Eterm* objv, int nobj)
 
429
minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
338
430
{
339
431
    /*
340
432
     * Allocate an old heap if we don't have one and if we'll need one.
373
465
        GEN_GCS(p)++;
374
466
        size_after = HEAP_TOP(p) - HEAP_START(p);
375
467
        need_after = size_after + need + stack_size;
376
 
        reclaimed += (size_before - size_after);
 
468
        *recl += (size_before - size_after);
377
469
        
378
470
        /*
379
471
         * Excessively large heaps should be shrunk, but
394
486
                wanted = erts_next_heap_size(wanted, 0);
395
487
            }
396
488
            if (wanted < HEAP_SIZE(p)) {
397
 
                shrink_new_heap(p, wanted, objv, nobj);
 
489
                erts_shrink_new_heap(p, wanted, objv, nobj);
398
490
            }
399
491
            ASSERT(HEAP_SIZE(p) == erts_next_heap_size(HEAP_SIZE(p), 0));
400
492
            return 1;           /* We are done. */
435
527
    n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP,
436
528
                                               sizeof(Eterm)*new_sz);
437
529
 
438
 
    if (p->ssb != NULL) {
439
 
        ssb_filter(p);
440
 
    }
441
530
    if (MBUF(p) != NULL) {
442
531
        n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj);
443
532
    }
444
533
 
445
 
    /*
446
 
     * If vectors have been used in this process, there could be
447
 
     * pointers from the oldest generation to the youngest.
448
 
     */
449
 
 
450
 
    if (p->ssb != NULL) {
451
 
        Eterm** ssb_p = p->ssb->buf;
452
 
        Eterm** limit = p->ssb->next;
453
 
 
454
 
        while (ssb_p < limit) {
455
 
            Eterm* ptr;
456
 
            Eterm val;
457
 
            Eterm* g_ptr = *ssb_p++;
458
 
 
459
 
            gval = *g_ptr;
460
 
            switch (primary_tag(gval)) {
461
 
            case TAG_PRIMARY_BOXED:
462
 
                ptr = boxed_val(gval);
463
 
                val = *ptr;
464
 
                if (IS_MOVED(val)) {
465
 
                    ASSERT(is_boxed(val));
466
 
                    *g_ptr = val;
467
 
                } else if (in_area(ptr, heap, mature_size)) {
468
 
                    MOVE_BOXED(ptr,val,old_htop,g_ptr);
469
 
                    if ((val & _HEADER_SUBTAG_MASK) == VECTOR_SUBTAG) {
470
 
                        Eterm** old_buf = p->ssb->buf;
471
 
                        Uint n = header_arity(val);
472
 
                        Eterm* hp = old_htop;
473
 
                        while (n--) {
474
 
                            hp--;                       
475
 
                            if (is_not_immed(*hp)) {
476
 
                                ERTS_SSB_PUT(p, hp);
477
 
                            }
478
 
                        }
479
 
                        ssb_p = p->ssb->buf + (ssb_p - old_buf);
480
 
                        limit = p->ssb->next;
481
 
                    }
482
 
                } else if (in_area(ptr, heap, heap_size)) {
483
 
                    MOVE_BOXED(ptr,val,n_htop,g_ptr);
484
 
                }
485
 
                break;
486
 
            case TAG_PRIMARY_LIST:
487
 
                ptr = list_val(gval);
488
 
                val = *ptr;
489
 
                if (is_non_value(val)) {
490
 
                    *g_ptr = ptr[1];
491
 
                } else if (in_area(ptr, heap, mature_size)) {
492
 
                    MOVE_CONS(ptr,val,old_htop,g_ptr);
493
 
                } else if (in_area(ptr, heap, heap_size)) {
494
 
                    MOVE_CONS(ptr,val,n_htop,g_ptr);
495
 
                }
496
 
                break;
497
 
            }
498
 
        }
499
 
    }
500
 
 
501
534
    n = setup_rootset(p, objv, nobj, &rootset);
502
535
    roots = rootset.roots;
503
536
 
519
552
                    *g_ptr++ = val;
520
553
                } else if (in_area(ptr, heap, mature_size)) {
521
554
                    MOVE_BOXED(ptr,val,old_htop,g_ptr++);
522
 
                    UPDATE_SSB(p,val,old_htop);
523
555
                } else if (in_area(ptr, heap, heap_size)) {
524
556
                    ASSERT(within(ptr, p));
525
557
                    MOVE_BOXED(ptr,val,n_htop,g_ptr++);
580
612
                    *n_hp++ = val;
581
613
                } else if (in_area(ptr, heap, mature_size)) {
582
614
                    MOVE_BOXED(ptr,val,old_htop,n_hp++);
583
 
                    UPDATE_SSB(p,val,old_htop);
584
615
                } else if (in_area(ptr, heap, heap_size)) {
585
616
                    MOVE_BOXED(ptr,val,n_htop,n_hp++);
586
617
                } else {
603
634
                break;
604
635
            }
605
636
            case TAG_PRIMARY_HEADER: {
606
 
                if (header_is_thing(gval))
 
637
                if (!header_is_thing(gval))
 
638
                    n_hp++;
 
639
                else {
 
640
                    if (header_is_bin_matchstate(gval)) {
 
641
                        ErlBinMatchState *ms = (ErlBinMatchState*) n_hp;
 
642
                        ErlBinMatchBuffer *mb = &(ms->mb);
 
643
                        Eterm* origptr = &(mb->orig);
 
644
                        ptr = boxed_val(*origptr);
 
645
                        val = *ptr;
 
646
                        if (IS_MOVED(val)) {
 
647
                            *origptr = val;
 
648
                            mb->base = binary_bytes(val);
 
649
                        } else if (in_area(ptr, heap, mature_size)) {
 
650
                            MOVE_BOXED(ptr,val,old_htop,origptr);
 
651
                            mb->base = binary_bytes(mb->orig);
 
652
                        } else if (in_area(ptr, heap, heap_size)) {
 
653
                            MOVE_BOXED(ptr,val,n_htop,origptr);
 
654
                            mb->base = binary_bytes(mb->orig);
 
655
                        }
 
656
                    }
607
657
                    n_hp += (thing_arityval(gval)+1);
608
 
                else
609
 
                    n_hp++;
 
658
                }
610
659
                break;
611
660
            }
612
661
            default:
631
680
        sweep_proc_bins(p, 0);
632
681
    }
633
682
 
634
 
#ifndef SHARED_HEAP
635
683
    if (MSO(p).funs) {
636
684
        sweep_proc_funs(p, 0);
637
685
    }
638
 
#endif
639
686
    if (MSO(p).externals) {
640
687
        sweep_proc_externals(p, 0);
641
688
    }
642
 
    remove_message_buffers(p);
643
689
 
644
 
#ifndef SHARED_HEAP
645
690
    /* Copy stack to end of new heap */
646
691
    n = p->hend - p->stop;
647
692
    sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm));
648
693
    p->stop = n_heap + new_sz - n;
649
 
#endif
650
694
 
651
695
#ifdef DEBUG
652
696
    sys_memset(HEAP_START(p), 0xf7, HEAP_SIZE(p) * sizeof(Eterm));
659
703
    HEAP_SIZE(p) = new_sz;
660
704
    HEAP_END(p) = n_heap + new_sz;
661
705
 
662
 
    if (p->ssb && p->ssb->next == p->ssb->buf) {
663
 
        erts_free(ERTS_ALC_T_SSB, p->ssb);
664
 
        p->ssb = NULL;
665
 
    }
666
 
 
667
 
#ifdef DEBUG
668
 
    verify_old_heap(p);
 
706
#ifdef HARDDEBUG
 
707
    disallow_heap_frag_ref_in_heap(p);
 
708
    disallow_heap_frag_ref_in_old_heap(p);
669
709
#endif
 
710
    remove_message_buffers(p);
670
711
}
671
712
 
672
713
static int
673
 
major_collection(Process* p, int need, Eterm* objv, int nobj)
 
714
major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
674
715
{
675
716
    Rootset rootset;
676
717
    Roots* roots;
832
873
                break;
833
874
            }
834
875
            case TAG_PRIMARY_HEADER: {
835
 
                if (header_is_thing(gval))
 
876
                if (!header_is_thing(gval))
 
877
                    n_hp++;
 
878
                else {
 
879
                    if (header_is_bin_matchstate(gval)) {
 
880
                        ErlBinMatchState *ms = (ErlBinMatchState*) n_hp;
 
881
                        ErlBinMatchBuffer *mb = &(ms->mb);
 
882
                        Eterm* origptr; 
 
883
                        origptr = &(mb->orig);
 
884
                        ptr = boxed_val(*origptr);
 
885
                        val = *ptr;
 
886
                        if (IS_MOVED(val)) {
 
887
                            *origptr = val;
 
888
                            mb->base = binary_bytes(*origptr);
 
889
                        } else if (in_area(ptr, src, src_size)) {
 
890
                            ASSERT(within(ptr, p));
 
891
                            MOVE_BOXED(ptr,val,n_htop,origptr); 
 
892
                            mb->base = binary_bytes(*origptr);
 
893
                            ptr = boxed_val(*origptr);
 
894
                            val = *ptr;
 
895
                        } else if (in_area(ptr, oh, oh_size)) {
 
896
                            ASSERT(within(ptr, p));
 
897
                            MOVE_BOXED(ptr,val,old_htop,origptr); 
 
898
                            mb->base = binary_bytes(*origptr);
 
899
                            ptr = boxed_val(*origptr);
 
900
                            val = *ptr;
 
901
#if 0
 
902
                        } else {
 
903
                            ASSERT(within(ptr, p));
 
904
                            MOVE_BOXED(ptr,val,n_htop,origptr); 
 
905
                            mb->base = binary_bytes(*origptr);
 
906
                            ptr = boxed_val(*origptr);
 
907
                            val = *ptr;
 
908
#endif
 
909
                        }
 
910
                    }
836
911
                    n_hp += (thing_arityval(gval)+1);
837
 
                else
838
 
                    n_hp++;
 
912
                }
839
913
                break;
840
914
            }
841
915
            default:
849
923
        old_htop = sweep_one_area(old_heap, old_htop, oh, oh_size);
850
924
    }
851
925
 
852
 
    /*
853
 
     * If vectors have been used in this process, there could be
854
 
     * pointers from the oldest generation to the youngest.
855
 
     * Sweep the new old_heap and update them.
856
 
     */
857
 
 
858
 
    if (p->ssb != NULL) {
859
 
        Eterm* o_hp = old_heap;
860
 
        char* nh = (char *) n_heap;
861
 
        Uint nh_size = (char *) n_htop - nh;
862
 
        
863
 
        p->ssb->next = p->ssb->buf;     /* Empty SSB; it will be re-built */
864
 
        while (o_hp != old_htop) {
865
 
            Eterm* ptr;
866
 
            Eterm val;
867
 
            Eterm gval = *o_hp;
868
 
            
869
 
            switch (primary_tag(gval)) {
870
 
            case TAG_PRIMARY_BOXED: {
871
 
                ptr = boxed_val(gval);
872
 
                val = *ptr;
873
 
                if (IS_MOVED(val)) {
874
 
                    ASSERT(is_boxed(val));
875
 
                    if (in_area(boxed_val(val),nh,nh_size)) {
876
 
                        ERTS_SSB_PUT(p, o_hp);
877
 
                    }
878
 
                    *o_hp++ = val;
879
 
                } else if (in_area(ptr, nh, nh_size)) {
880
 
                    ERTS_SSB_PUT(p, o_hp);
881
 
                    o_hp++;
882
 
                } else if (in_area(ptr, src, src_size)) {
883
 
                    MOVE_BOXED(ptr,val,old_htop,o_hp++);
884
 
                } else if (in_area(ptr, oh, oh_size)) {
885
 
                    MOVE_BOXED(ptr,val,old_htop,o_hp++);
886
 
                } else {
887
 
                    o_hp++;
888
 
                }
889
 
                break;
890
 
            }
891
 
            case TAG_PRIMARY_LIST: {
892
 
                ptr = list_val(gval);
893
 
                val = *ptr;
894
 
                if (is_non_value(val)) {
895
 
                    val = ptr[1];
896
 
                    if (in_area(list_val(val),nh,nh_size)) {
897
 
                        ERTS_SSB_PUT(p, o_hp);
898
 
                    }
899
 
                    *o_hp++ = val;
900
 
                } else if (in_area(ptr, nh, nh_size)) {
901
 
                    ERTS_SSB_PUT(p, o_hp);
902
 
                    o_hp++;
903
 
                } else if (in_area(ptr, src, src_size)) {
904
 
                    MOVE_CONS(ptr,val,old_htop,o_hp++);
905
 
                } else if (in_area(ptr, oh, oh_size)) {
906
 
                    MOVE_CONS(ptr,val,old_htop,o_hp++);
907
 
                } else {
908
 
                    o_hp++;
909
 
                }
910
 
                break;
911
 
            }
912
 
            case TAG_PRIMARY_HEADER:
913
 
                if (header_is_thing(gval))
914
 
                    o_hp += (thing_arityval(gval)+1);
915
 
                else
916
 
                    o_hp++;
917
 
                break;
918
 
            default:
919
 
                o_hp++;
920
 
                break;
921
 
            }
922
 
        }
923
 
 
924
 
        /*
925
 
         * If no pointers left from old to young, delete the SSB.
926
 
         */
927
 
        if (p->ssb->next == p->ssb->buf) {
928
 
            erts_free(ERTS_ALC_T_SSB, p->ssb);
929
 
            p->ssb = NULL;
930
 
        }
931
 
    }
932
 
 
933
926
    if (MSO(p).mso) {
934
927
        sweep_proc_bins(p, 1);
935
928
    }
936
 
#ifndef SHARED_HEAP
937
929
    if (MSO(p).funs) {
938
930
        sweep_proc_funs(p, 1);
939
931
    }
940
 
#endif
941
932
    if (MSO(p).externals) {
942
933
        sweep_proc_externals(p, 1);
943
934
    }
944
 
    remove_message_buffers(p);
945
935
 
946
936
    if (OLD_HEAP(p) != NULL) {
947
937
#ifdef DEBUG
956
946
        OLD_HEND(p) = old_heap + new_oh_size;
957
947
    }
958
948
 
959
 
#ifndef SHARED_HEAP
960
949
    /* Move the stack to the end of the heap */
961
950
    n = HEAP_END(p) - p->stop;
962
951
    sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm));
963
952
    p->stop = n_heap + new_sz - n;
964
 
#endif
965
953
 
966
954
#ifdef DEBUG
967
955
    sys_memset(HEAP_START(p), 0xf3,
978
966
    GEN_GCS(p) = 0;
979
967
    HIGH_WATER(p) = HEAP_TOP(p);
980
968
 
981
 
    adjust_after_fullsweep(p, size_before, need, objv, nobj);
 
969
    *recl += adjust_after_fullsweep(p, size_before, need, objv, nobj);
 
970
 
 
971
#ifdef HARDDEBUG
 
972
    disallow_heap_frag_ref_in_heap(p);
 
973
    disallow_heap_frag_ref_in_old_heap(p);
 
974
#endif
 
975
    remove_message_buffers(p);
 
976
 
982
977
    OverRunCheck();
983
 
 
984
 
#ifdef DEBUG
985
 
    verify_old_heap(p);
986
 
#endif
987
978
    return 1;                   /* We are done. */
988
979
}
989
980
 
990
 
static void
 
981
static Uint
991
982
adjust_after_fullsweep(Process *p, int size_before, int need, Eterm *objv, int nobj)
992
983
{
993
984
    int wanted, sz, size_after, need_after;
994
985
    int stack_size = STACK_SZ_ON_HEAP(p);
995
 
    
 
986
    Uint reclaimed_now;
 
987
 
996
988
    size_after = (HEAP_TOP(p) - HEAP_START(p));
997
 
    reclaimed += (size_before - size_after);
 
989
    reclaimed_now = (size_before - size_after);
998
990
    
999
991
    /*
1000
992
     * Resize the heap if needed.
1021
1013
            sz = erts_next_heap_size(wanted, 0);
1022
1014
        }
1023
1015
        if (sz < HEAP_SIZE(p)) {
1024
 
            shrink_new_heap(p, sz, objv, nobj);
 
1016
            erts_shrink_new_heap(p, sz, objv, nobj);
1025
1017
        }
1026
1018
    }
 
1019
    return reclaimed_now;
1027
1020
}
1028
1021
 
1029
1022
/*
1035
1028
    ErlHeapFragment* bp = MBUF(p);
1036
1029
 
1037
1030
    MBUF(p) = NULL;
1038
 
    HALLOC_MBUF(p) = NULL;
1039
1031
    MBUF_SIZE(p) = 0;
1040
1032
    while (bp != NULL) {
1041
1033
        ErlHeapFragment* next_bp = bp->next;
1055
1047
collect_root_array(Process* p, Eterm* n_htop, Eterm* objv, int nobj)
1056
1048
{
1057
1049
    ErlHeapFragment* qb;
1058
 
    char* heap_part = (char *) ARITH_LOWEST_HTOP(p);
1059
 
    Uint heap_part_size;
1060
1050
    Eterm gval;
1061
1051
    Eterm* ptr;
1062
1052
    Eterm val;
1063
1053
 
1064
1054
    ASSERT(p->htop != NULL);
1065
 
#ifndef SHARED_HEAP
1066
 
    ASSERT(heap_part != NULL);
1067
 
#else
1068
 
    if (heap_part == NULL) {
1069
 
        heap_part = (char *) p->htop;
1070
 
    }
1071
 
#endif
1072
 
    heap_part_size = (char *)p->htop - heap_part;
1073
 
 
1074
1055
    while (nobj--) {
1075
1056
        gval = *objv;
1076
1057
        
1083
1064
                ASSERT(is_boxed(val));
1084
1065
                *objv++ = val;
1085
1066
            } else {
1086
 
                if (in_area(ptr, heap_part, heap_part_size)) {
1087
 
                    MOVE_BOXED(ptr,val,n_htop,objv);
1088
 
                } else {
1089
 
                    for (qb = MBUF(p); qb != NULL; qb = qb->next) {
1090
 
                        if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
1091
 
                            MOVE_BOXED(ptr,val,n_htop,objv);
1092
 
                            break;
1093
 
                        }
 
1067
                for (qb = MBUF(p); qb != NULL; qb = qb->next) {
 
1068
                    if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
 
1069
                        MOVE_BOXED(ptr,val,n_htop,objv);
 
1070
                        break;
1094
1071
                    }
1095
1072
                }
1096
1073
                objv++;
1104
1081
            if (is_non_value(val)) {
1105
1082
                *objv++ = ptr[1];
1106
1083
            } else {
1107
 
                if (in_area(ptr, heap_part, heap_part_size)) {
1108
 
                    MOVE_CONS(ptr,val,n_htop,objv);
1109
 
                } else {
1110
 
                    for (qb = MBUF(p); qb != NULL; qb = qb->next) {
1111
 
                        if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
1112
 
                            MOVE_CONS(ptr,val,n_htop,objv);
1113
 
                            break;
1114
 
                        }
 
1084
                for (qb = MBUF(p); qb != NULL; qb = qb->next) {
 
1085
                    if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
 
1086
                        MOVE_CONS(ptr,val,n_htop,objv);
 
1087
                        break;
1115
1088
                    }
1116
1089
                }
1117
1090
                objv++;
1128
1101
    return n_htop;
1129
1102
}
1130
1103
 
 
1104
#ifdef HARDDEBUG
 
1105
static void
 
1106
disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj)
 
1107
{
 
1108
    ErlHeapFragment* mbuf;
 
1109
    ErlHeapFragment* qb;
 
1110
    Eterm gval;
 
1111
    Eterm* ptr;
 
1112
    Eterm val;
 
1113
 
 
1114
    ASSERT(p->htop != NULL);
 
1115
    mbuf = MBUF(p);
 
1116
 
 
1117
    while (nobj--) {
 
1118
        gval = *objv;
 
1119
        
 
1120
        switch (primary_tag(gval)) {
 
1121
 
 
1122
        case TAG_PRIMARY_BOXED: {
 
1123
            ptr = boxed_val(gval);
 
1124
            val = *ptr;
 
1125
            if (IS_MOVED(val)) {
 
1126
                ASSERT(is_boxed(val));
 
1127
                objv++;
 
1128
            } else {
 
1129
                for (qb = mbuf; qb != NULL; qb = qb->next) {
 
1130
                    if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
 
1131
                        abort();
 
1132
                    }
 
1133
                }
 
1134
                objv++;
 
1135
            }
 
1136
            break;
 
1137
        }
 
1138
 
 
1139
        case TAG_PRIMARY_LIST: {
 
1140
            ptr = list_val(gval);
 
1141
            val = *ptr;
 
1142
            if (is_non_value(val)) {
 
1143
                objv++;
 
1144
            } else {
 
1145
                for (qb = mbuf; qb != NULL; qb = qb->next) {
 
1146
                    if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
 
1147
                        abort();
 
1148
                    }
 
1149
                }
 
1150
                objv++;
 
1151
            }
 
1152
            break;
 
1153
        }
 
1154
 
 
1155
        default: {
 
1156
            objv++;
 
1157
            break;
 
1158
        }
 
1159
        }
 
1160
    }
 
1161
}
 
1162
 
 
1163
static void
 
1164
disallow_heap_frag_ref_in_heap(Process* p)
 
1165
{
 
1166
    Eterm* hp;
 
1167
    Eterm* htop;
 
1168
    Eterm* heap;
 
1169
    Uint heap_size;
 
1170
 
 
1171
    if (p->mbuf == 0) {
 
1172
        return;
 
1173
    }
 
1174
 
 
1175
    htop = p->htop;
 
1176
    heap = p->heap;
 
1177
    heap_size = (htop - heap)*sizeof(Eterm);
 
1178
 
 
1179
    hp = heap;
 
1180
    while (hp < htop) {
 
1181
        ErlHeapFragment* qb;
 
1182
        Eterm* ptr;
 
1183
        Eterm val;
 
1184
 
 
1185
        val = *hp++;
 
1186
        switch (primary_tag(val)) {
 
1187
        case TAG_PRIMARY_BOXED:
 
1188
            ptr = boxed_val(val);
 
1189
            if (!in_area(ptr, heap, heap_size)) {
 
1190
                for (qb = MBUF(p); qb != NULL; qb = qb->next) {
 
1191
                    if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
 
1192
                        abort();
 
1193
                    }
 
1194
                }
 
1195
            }
 
1196
            break;
 
1197
        case TAG_PRIMARY_LIST:
 
1198
            ptr = list_val(val);
 
1199
            if (!in_area(ptr, heap, heap_size)) {
 
1200
                for (qb = MBUF(p); qb != NULL; qb = qb->next) {
 
1201
                    if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
 
1202
                        abort();
 
1203
                    }
 
1204
                }
 
1205
            }
 
1206
            break;
 
1207
        case TAG_PRIMARY_HEADER:
 
1208
            if (header_is_thing(val)) {
 
1209
                hp += thing_arityval(val);
 
1210
            }
 
1211
            break;
 
1212
        }
 
1213
    }
 
1214
}
 
1215
 
 
1216
static void
 
1217
disallow_heap_frag_ref_in_old_heap(Process* p)
 
1218
{
 
1219
    Eterm* hp;
 
1220
    Eterm* htop;
 
1221
    Eterm* old_heap;
 
1222
    Uint old_heap_size;
 
1223
    Eterm* new_heap;
 
1224
    Uint new_heap_size;
 
1225
 
 
1226
    htop = p->old_htop;
 
1227
    old_heap = p->old_heap;
 
1228
    old_heap_size = (htop - old_heap)*sizeof(Eterm);
 
1229
    new_heap = p->heap;
 
1230
    new_heap_size = (p->htop - new_heap)*sizeof(Eterm);
 
1231
 
 
1232
    hp = old_heap;
 
1233
    while (hp < htop) {
 
1234
        ErlHeapFragment* qb;
 
1235
        Eterm* ptr;
 
1236
        Eterm val;
 
1237
 
 
1238
        val = *hp++;
 
1239
        switch (primary_tag(val)) {
 
1240
        case TAG_PRIMARY_BOXED:
 
1241
            ptr = boxed_val(val);
 
1242
            if (in_area(ptr, new_heap, new_heap_size)) {
 
1243
                abort();
 
1244
            }
 
1245
            if (!in_area(ptr, old_heap, old_heap_size)) {
 
1246
                for (qb = MBUF(p); qb != NULL; qb = qb->next) {
 
1247
                    if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
 
1248
                        abort();
 
1249
                    }
 
1250
                }
 
1251
            }
 
1252
            break;
 
1253
        case TAG_PRIMARY_LIST:
 
1254
            ptr = list_val(val);
 
1255
            if (in_area(ptr, new_heap, new_heap_size)) {
 
1256
                abort();
 
1257
            }
 
1258
            if (!in_area(ptr, old_heap, old_heap_size)) {
 
1259
                for (qb = MBUF(p); qb != NULL; qb = qb->next) {
 
1260
                    if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
 
1261
                        abort();
 
1262
                    }
 
1263
                }
 
1264
            }
 
1265
            break;
 
1266
        case TAG_PRIMARY_HEADER:
 
1267
            if (header_is_thing(val)) {
 
1268
                hp += thing_arityval(val);
 
1269
                if (!in_area(hp, old_heap, old_heap_size+1)) {
 
1270
                    abort();
 
1271
                }
 
1272
            }
 
1273
            break;
 
1274
        }
 
1275
    }
 
1276
}
 
1277
#endif
 
1278
 
1131
1279
static Eterm*
1132
1280
sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
1133
1281
{
1163
1311
            break;
1164
1312
        }
1165
1313
        case TAG_PRIMARY_HEADER: {
1166
 
            if (header_is_thing(gval))
 
1314
            if (!header_is_thing(gval)) {
 
1315
                n_hp++;
 
1316
            } else {
 
1317
                if (header_is_bin_matchstate(gval)) {
 
1318
                    ErlBinMatchState *ms = (ErlBinMatchState*) n_hp;
 
1319
                    ErlBinMatchBuffer *mb = &(ms->mb);
 
1320
                    Eterm* origptr;     
 
1321
                    origptr = &(mb->orig);
 
1322
                    ptr = boxed_val(*origptr);
 
1323
                    val = *ptr;
 
1324
                    if (IS_MOVED(val)) {
 
1325
                        *origptr = val;
 
1326
                        mb->base = binary_bytes(*origptr);
 
1327
                    } else if (in_area(ptr, src, src_size)) {
 
1328
                        MOVE_BOXED(ptr,val,n_htop,origptr); 
 
1329
                        mb->base = binary_bytes(*origptr);
 
1330
                    }
 
1331
                }
1167
1332
                n_hp += (thing_arityval(gval)+1);
1168
 
            else
1169
 
                n_hp++;
 
1333
            }
1170
1334
            break;
1171
1335
        }
1172
1336
        default:
1194
1358
                *o_hp++ = val;
1195
1359
            } else if (in_area(ptr, src, src_size)) {
1196
1360
                MOVE_BOXED(ptr,val,o_htop,o_hp++);
1197
 
                UPDATE_SSB(p,val,o_htop);
1198
1361
            } else {
1199
1362
                o_hp++;
1200
1363
            }
1213
1376
            break;
1214
1377
        }
1215
1378
        case TAG_PRIMARY_HEADER: {
1216
 
            if (header_is_thing(gval))
 
1379
            if (!header_is_thing(gval)) {
 
1380
                o_hp++;
 
1381
            } else  {
 
1382
                if (header_is_bin_matchstate(gval)) {
 
1383
                    ErlBinMatchState *ms = (ErlBinMatchState*) o_hp;
 
1384
                    ErlBinMatchBuffer *mb = &(ms->mb);
 
1385
                    Eterm* origptr = &(mb->orig);
 
1386
                    Eterm* ptr = boxed_val(*origptr);
 
1387
                    val = *ptr;
 
1388
                    if (IS_MOVED(val)) {
 
1389
                        *origptr = val;
 
1390
                        mb->base = binary_bytes(val);
 
1391
                    } else if (in_area(ptr, src, src_size)) {
 
1392
                        MOVE_BOXED(ptr,val,o_htop,origptr);
 
1393
                        mb->base = binary_bytes(mb->orig);
 
1394
                    }
 
1395
                }
1217
1396
                o_hp += (thing_arityval(gval)+1);
1218
 
            else
1219
 
                o_hp++;
 
1397
            }
1220
1398
            break;
1221
1399
        }
1222
1400
        default:
1227
1405
    return o_htop;
1228
1406
}
1229
1407
 
 
1408
 
1230
1409
/*
1231
1410
 * Collect heap fragments and check that they point in the correct direction.
1232
1411
 */
1239
1418
    char* frag_begin;
1240
1419
    Uint frag_size;
1241
1420
    ErlMessage* mp;
1242
 
    ErlHeapFragment* halloc_mbuf;
 
1421
 
 
1422
    /*
 
1423
     * Checking...
 
1424
     */
 
1425
#ifdef HARDDEBUG
 
1426
    disallow_heap_frag_ref(p, n_htop, p->stop, STACK_START(p) - p->stop);
 
1427
    disallow_heap_frag_ref_in_heap(p);
 
1428
#endif
1243
1429
 
1244
1430
    /*
1245
1431
     * Go through the root set, move everything that it is in one of the
1252
1438
    if (is_not_immed(p->fvalue)) {
1253
1439
        n_htop = collect_root_array(p, n_htop, &p->fvalue, 1);
1254
1440
    }
 
1441
    if (is_not_immed(p->ftrace)) {
 
1442
        n_htop = collect_root_array(p, n_htop, &p->ftrace, 1);
 
1443
    }
1255
1444
    if (is_not_immed(p->seq_trace_token)) {
1256
1445
        n_htop = collect_root_array(p, n_htop, &p->seq_trace_token, 1);
1257
1446
    }
1263
1452
                                    p->dictionary->data,
1264
1453
                                    p->dictionary->used);
1265
1454
    }
 
1455
#ifdef HARDDEBUG
1266
1456
    if (p->debug_dictionary != NULL) {
1267
 
        n_htop = collect_root_array(p, n_htop,
1268
 
                                    p->debug_dictionary->data,
1269
 
                                    p->debug_dictionary->used);
1270
 
    }
1271
 
 
1272
 
    n_htop = collect_root_array(p, n_htop, p->stop, STACK_START(p) - p->stop);
1273
 
 
1274
 
#ifdef SHARED_HEAP
1275
 
    /*
1276
 
     * Go through the message queues for all active processes.
1277
 
     */
1278
 
 
1279
 
    {
1280
 
        Uint i;
1281
 
        Uint limit = erts_num_active_procs;
1282
 
        Process* tp;
1283
 
 
1284
 
        for (i = 0; i < limit; i++) {
1285
 
            tp = erts_active_procs[i];
1286
 
            if (!tp->active) {
1287
 
                continue;
1288
 
            }
1289
 
            if (is_not_immed(tp->fvalue)) {
1290
 
                n_htop = collect_root_array(p, n_htop, &tp->fvalue, 1);
1291
 
            }
1292
 
            if (is_not_immed(tp->group_leader)) {
1293
 
                n_htop = collect_root_array(p, n_htop, &tp->group_leader, 1);
1294
 
            }
1295
 
            for (mp = tp->msg.first; mp != NULL; mp = mp->next) {
1296
 
                if (is_not_immed(ERL_MESSAGE_TERM(mp)) ||
1297
 
                    is_not_immed(ERL_MESSAGE_TOKEN(mp))) {
1298
 
                    n_htop = collect_root_array(p, n_htop, mp->m, 2);
1299
 
                }
1300
 
            }
1301
 
        }
1302
 
    }
1303
 
#else
1304
 
    /*
1305
 
     * Go through the message queue, move everything that it is in one of the
 
1457
        disallow_heap_frag_ref(p, n_htop,
 
1458
                               p->debug_dictionary->data,
 
1459
                               p->debug_dictionary->used);
 
1460
    }
 
1461
#endif
 
1462
 
 
1463
    /*
 
1464
     * Go through the message queue, move everything that is in one of the
1306
1465
     * heap fragments to our new heap.
1307
1466
     */
1308
1467
 
1311
1470
            n_htop = collect_root_array(p, n_htop, mp->m, 2);
1312
1471
        }
1313
1472
    }
1314
 
#endif
1315
1473
 
1316
1474
    /*
1317
1475
     * Now all references in the root set point to the new heap. However,
1318
 
     * many references on the new heap point to other heap fragments.
1319
 
     * So the next stage is to scan through the new heap evacuating data
1320
 
     * from the old heap until everything is copied.
1321
 
     *
1322
 
     * We must scan the heap once for every heap framgent. Order:
1323
 
     *
1324
 
     * 1. All heap fragments allocated by HAlloc().
1325
 
     * 2. The part of the heap that may contain pointers into ArithAlloc'ed
1326
 
     *    heap fragments.
1327
 
     * 3. All heap fragments allocated by ArithAlloc().
 
1476
     * many references on the new heap point to heap fragments.
1328
1477
     */
1329
1478
 
1330
 
    ASSERT(ARITH_LOWEST_HTOP(p) <= p->htop);
1331
1479
    qb = MBUF(p);
1332
 
    if ((halloc_mbuf = HALLOC_MBUF(p)) != NULL) {
1333
 
        /*
1334
 
         * Sweep using all heap fragments allocated by HAlloc().
1335
 
         */
1336
 
        for (;;) {
1337
 
            frag_begin = (char *) qb->mem;
1338
 
            frag_size = qb->size * sizeof(Eterm);
1339
 
            n_htop = sweep_one_area(n_hstart, n_htop, frag_begin, frag_size);
1340
 
            if (qb == halloc_mbuf) {
1341
 
                qb = qb->next;
1342
 
                break;
1343
 
            }
1344
 
            qb = qb->next;
1345
 
        }
1346
 
    }
1347
 
 
1348
 
    /*
1349
 
     * Sweep using part of the heap as source.
1350
 
     */
1351
 
 
1352
 
    frag_begin = (char *) ARITH_LOWEST_HTOP(p);
1353
 
    if (frag_begin == NULL) {
1354
 
        frag_size = 0;
1355
 
    } else {
1356
 
        frag_size = (char *)p->htop - frag_begin;
1357
 
    }
1358
 
    if (frag_size != 0) {
1359
 
        n_htop = sweep_one_area(n_hstart, n_htop, frag_begin, frag_size);
1360
 
    }
1361
 
 
1362
 
    /*
1363
 
     * Sweep using the remaining heap fragments (allocated by ArithAlloc()).
1364
 
     */
1365
 
 
1366
1480
    while (qb != NULL) {
1367
1481
        frag_begin = (char *) qb->mem;
1368
1482
        frag_size = qb->size * sizeof(Eterm);
1374
1488
    return n_htop;
1375
1489
}
1376
1490
 
1377
 
static Uint INLINE
 
1491
static Uint ERTS_INLINE
1378
1492
add_to_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset, Uint n)
1379
1493
{
1380
1494
    Uint avail;
1437
1551
 
1438
1552
    /*
1439
1553
     * The process may be garbage-collected while it is terminating.
1440
 
     * (fvalue contains the EXIT reason.)
 
1554
     * (fvalue contains the EXIT reason and ftrace the saved stack trace.)
1441
1555
     */
1442
1556
    if (is_not_immed(p->fvalue)) {
1443
1557
        roots[n].v  = &p->fvalue;
1444
1558
        roots[n].sz = 1;
1445
1559
        n++;
1446
1560
    }
 
1561
    if (is_not_immed(p->ftrace)) {
 
1562
        roots[n].v  = &p->ftrace;
 
1563
        roots[n].sz = 1;
 
1564
        n++;
 
1565
    }
1447
1566
 
1448
1567
    mp = p->msg.first;
1449
1568
    avail = rootset->size - n;
1472
1591
    return n;
1473
1592
}
1474
1593
 
1475
 
#ifdef SHARED_HEAP
1476
 
static Uint
1477
 
setup_rootset(Process *current, Eterm *objv, int nobj, Rootset *rootset)
1478
 
{
1479
 
    Process* p;
1480
 
    Uint i;
1481
 
    Uint limit;
1482
 
    Uint n = 0;
1483
 
 
1484
 
    rootset->roots = rootset->def;
1485
 
    rootset->size = ALENGTH(rootset->def);
1486
 
    limit = erts_num_active_procs;
1487
 
    for (i = 0; i < limit; i++) {
1488
 
        p = erts_active_procs[i];
1489
 
        if (p->active) {
1490
 
            if (p == current) {
1491
 
                n = add_to_rootset(p, objv, nobj, rootset, n);
1492
 
            } else {
1493
 
                n = add_to_rootset(p, p->arg_reg, p->arity, rootset, n);
1494
 
            }
1495
 
        }
1496
 
    }
1497
 
    return n;
1498
 
}
1499
 
#else
1500
1594
static Uint
1501
1595
setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
1502
1596
{
1504
1598
    rootset->size = ALENGTH(rootset->def);
1505
1599
    return add_to_rootset(p, objv, nobj, rootset, 0);
1506
1600
}
1507
 
#endif
1508
1601
 
1509
1602
static
1510
1603
void cleanup_rootset(Rootset* rootset)
1519
1612
{
1520
1613
    Eterm* new_heap;
1521
1614
    int heap_size = HEAP_TOP(p) - HEAP_START(p);
1522
 
#ifndef SHARED_HEAP
1523
1615
    int stack_size = p->hend - p->stop;
1524
 
#endif
1525
 
    Sint32 offs;
 
1616
    Sint offs;
1526
1617
 
1527
1618
    ASSERT(HEAP_SIZE(p) < new_sz);
1528
1619
    new_heap = (Eterm *) ERTS_HEAP_REALLOC(ERTS_ALC_T_HEAP,
1532
1623
 
1533
1624
    if ((offs = new_heap - HEAP_START(p)) == 0) { /* No move. */
1534
1625
        HEAP_END(p) = new_heap + new_sz;
1535
 
#ifndef SHARED_HEAP
1536
1626
        sys_memmove(p->hend - stack_size, p->stop, stack_size * sizeof(Eterm));
1537
1627
        p->stop = p->hend - stack_size;
1538
 
#endif
1539
1628
    } else {
1540
1629
        char* area = (char *) HEAP_START(p);
1541
1630
        Uint area_size = (char *) HEAP_TOP(p) - area;
1542
 
#ifndef SHARED_HEAP
1543
1631
        Eterm* prev_stop = p->stop;
1544
 
#endif
1545
1632
 
1546
1633
        offset_heap(new_heap, heap_size, offs, area, area_size);
1547
1634
        HIGH_WATER(p) = new_heap + (HIGH_WATER(p) - HEAP_START(p));
1548
1635
 
1549
1636
        HEAP_END(p) = new_heap + new_sz;
1550
 
#ifndef SHARED_HEAP
1551
1637
        prev_stop = new_heap + (p->stop - p->heap);
1552
1638
        p->stop = p->hend - stack_size;
1553
1639
        sys_memmove(p->stop, prev_stop, stack_size * sizeof(Eterm));
1554
 
#endif
 
1640
 
1555
1641
        offset_rootset(p, offs, area, area_size, objv, nobj);
1556
1642
        HEAP_TOP(p) = new_heap + heap_size;
1557
1643
        HEAP_START(p) = new_heap;
1559
1645
    HEAP_SIZE(p) = new_sz;
1560
1646
}
1561
1647
 
1562
 
static void
1563
 
shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj)
 
1648
void
 
1649
erts_shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj)
1564
1650
{
1565
1651
    Eterm* new_heap;
1566
1652
    int heap_size = HEAP_TOP(p) - HEAP_START(p);
1567
1653
    Sint offs;
1568
1654
 
1569
 
#ifdef SHARED_HEAP
1570
 
    ASSERT(new_sz < HEAP_SIZE(p));
1571
 
 
1572
 
    new_heap = (Eterm *) ERTS_HEAP_REALLOC(ERTS_ALC_T_HEAP,
1573
 
                                           (void*)HEAP_START(p),
1574
 
                                           sizeof(Eterm)*(HEAP_SIZE(p)),
1575
 
                                           sizeof(Eterm)*new_sz);
1576
 
    HEAP_END(p) = new_heap + new_sz;
1577
 
#else
1578
1655
    int stack_size = p->hend - p->stop;
1579
1656
 
1580
1657
    ASSERT(new_sz < p->heap_sz);
1586
1663
                                           sizeof(Eterm)*new_sz);
1587
1664
    p->hend = new_heap + new_sz;
1588
1665
    p->stop = p->hend - stack_size;
1589
 
#endif
1590
1666
 
1591
1667
    if ((offs = new_heap - HEAP_START(p)) != 0) {
1592
1668
        char* area = (char *) HEAP_START(p);
1640
1716
            prev = &ptr->next;
1641
1717
            ptr = ptr->next;
1642
1718
        } else {                /* Object has not been moved - deref it */
1643
 
            DEREF_ERL_NODE(ptr->node);
 
1719
            erts_deref_node_entry(ptr->node);
1644
1720
            *prev = ptr = ptr->next;
1645
1721
        }
1646
1722
    }
1647
1723
    ASSERT(*prev == NULL);
1648
1724
}
1649
1725
 
1650
 
#ifndef SHARED_HEAP
1651
1726
static void
1652
1727
sweep_proc_funs(Process *p, int fullsweep)
1653
1728
{
1684
1759
            ErlFunEntry* fe = ptr->fe;
1685
1760
 
1686
1761
            *prev = ptr = ptr->next;
1687
 
            if (--(fe->refc) == 0) {
 
1762
            if (erts_refc_dectest(&fe->refc, 0) == 0) {
1688
1763
                erts_erase_fun_entry(fe);
1689
1764
            }
1690
1765
        }
1691
1766
    }
1692
1767
    ASSERT(*prev == NULL);
1693
1768
}
1694
 
#endif
1695
1769
 
1696
1770
static void
1697
1771
sweep_proc_bins(Process *p, int fullsweep)
1737
1811
        } else {                /* Object has not been moved - deref it */
1738
1812
            *prev = ptr->next;
1739
1813
            bptr = ptr->val;
1740
 
            bptr->refc--;
1741
 
            if (bptr->refc == 0) {
 
1814
            if (erts_refc_dectest(&bptr->refc, 0) == 0) {
1742
1815
                if (bptr->flags & BIN_FLAG_MATCH_PROG) {
1743
1816
                    erts_match_set_free(bptr);
1744
1817
                } else {
1789
1862
                      hp += tari + 1;
1790
1863
                  }
1791
1864
                  break;
 
1865
              case BIN_MATCHSTATE_SUBTAG:
 
1866
                {       
 
1867
                  ErlBinMatchState *ms = (ErlBinMatchState*) hp;
 
1868
                  ErlBinMatchBuffer *mb = &(ms->mb);
 
1869
                  if (in_area(ptr_val(mb->orig), area, area_size)) {
 
1870
                      mb->orig = offset_ptr(mb->orig, offs);
 
1871
                      mb->base = binary_bytes(mb->orig);
 
1872
                  }
 
1873
                  sz -= tari;
 
1874
                  hp += tari + 1;
 
1875
                }
 
1876
                break;
1792
1877
              case FUN_SUBTAG:
1793
1878
                  {
1794
 
#ifndef SHARED_HEAP
1795
1879
                      ErlFunThing* funp = (ErlFunThing *) hp;
1796
1880
                      Eterm** uptr = (Eterm **) &funp->next;
1797
1881
 
1798
1882
                      if (*uptr && in_area((Eterm *)funp->next, area, area_size)) {
1799
1883
                          *uptr += offs;
1800
1884
                      }
1801
 
#endif
1802
1885
                      sz -= tari;
1803
1886
                      hp += tari + 1;
1804
1887
                  }
1855
1938
}
1856
1939
 
1857
1940
static void
1858
 
offset_off_heap(Process* p, int offs, char* area, Uint area_size)
 
1941
offset_off_heap(Process* p, Sint offs, char* area, Uint area_size)
1859
1942
{
1860
1943
    if (MSO(p).mso && in_area((Eterm *)MSO(p).mso, area, area_size)) {
1861
1944
        Eterm** uptr = (Eterm**) &MSO(p).mso;
1862
1945
        *uptr += offs;
1863
1946
    }
1864
1947
 
1865
 
#ifndef SHARED_HEAP
1866
1948
    if (MSO(p).funs && in_area((Eterm *)MSO(p).funs, area, area_size)) {
1867
1949
        Eterm** uptr = (Eterm**) &MSO(p).funs;
1868
1950
        *uptr += offs;
1869
1951
    }
1870
 
#endif
1871
1952
 
1872
1953
    if (MSO(p).externals && in_area((Eterm *)MSO(p).externals, area, area_size)) {
1873
1954
        Eterm** uptr = (Eterm**) &MSO(p).externals;
1905
1986
    }
1906
1987
}
1907
1988
 
1908
 
static void INLINE
1909
 
offset_one_rootset(Process *p, int offs, char* area, Uint area_size,
 
1989
static void ERTS_INLINE
 
1990
offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size,
1910
1991
               Eterm* objv, int nobj)
1911
1992
{
1912
1993
    if (p->dictionary)  {
1919
2000
                    p->debug_dictionary->used, 
1920
2001
                    offs, area, area_size);
1921
2002
    }
1922
 
    offset_heap(&p->fvalue, 1, offs, area, area_size);
1923
 
    offset_heap(&p->seq_trace_token, 1, offs, area, area_size);
1924
 
    offset_heap(&p->group_leader, 1, offs, area, area_size);
 
2003
    offset_heap_ptr(&p->fvalue, 1, offs, area, area_size);
 
2004
    offset_heap_ptr(&p->ftrace, 1, offs, area, area_size);
 
2005
    offset_heap_ptr(&p->seq_trace_token, 1, offs, area, area_size);
 
2006
    offset_heap_ptr(&p->group_leader, 1, offs, area, area_size);
1925
2007
    offset_mqueue(p, offs, area, area_size);
1926
2008
    offset_heap_ptr(p->stop, (STACK_START(p) - p->stop), offs, area, area_size);
1927
2009
    if (nobj > 0) {
1928
 
        offset_heap(objv, nobj, offs, area, area_size);
 
2010
        offset_heap_ptr(objv, nobj, offs, area, area_size);
1929
2011
    }
1930
2012
    offset_off_heap(p, offs, area, area_size);
1931
2013
}
1932
2014
 
1933
2015
static void
1934
 
offset_rootset(Process *p, int offs, char* area, Uint area_size,
 
2016
offset_rootset(Process *p, Sint offs, char* area, Uint area_size,
1935
2017
               Eterm* objv, int nobj)
1936
2018
{
1937
 
#ifndef SHARED_HEAP
1938
2019
    offset_one_rootset(p, offs, area, area_size, objv, nobj);
1939
 
#else
1940
 
    Uint i;
1941
 
    Uint limit = erts_num_active_procs;
1942
 
    Process* current = p;
1943
 
 
1944
 
    for (i = 0; i < limit; i++) {
1945
 
        p = erts_active_procs[i];
1946
 
        if (p->active) {
1947
 
            if (p == current) {
1948
 
                offset_one_rootset(p, offs, area, area_size, objv, nobj);
1949
 
            } else {
1950
 
                offset_one_rootset(p, offs, area, area_size, p->arg_reg, p->arity);
1951
 
            }
1952
 
        }
1953
 
    }
1954
 
#endif
1955
 
    
1956
 
    if (p->ssb != NULL) {
1957
 
        Eterm** ssb_p = p->ssb->buf;
1958
 
        Eterm** limit = p->ssb->next;
1959
 
 
1960
 
        while (ssb_p < limit) {
1961
 
            offset_heap(*ssb_p++, 1, offs, area, area_size);
1962
 
        }
1963
 
    }
1964
 
 
1965
 
}
1966
 
 
1967
 
static char*
1968
 
print_pid(Process *p)
1969
 
{
1970
 
    char static buf[64];
1971
 
 
1972
 
    Eterm obj = p->id;
1973
 
    sprintf(buf,
1974
 
            "<%lu.%lu.%lu>",
1975
 
            internal_pid_channel_no(obj),
1976
 
            internal_pid_number(obj),
1977
 
            internal_pid_serial(obj));
1978
 
    return buf;
1979
2020
}
1980
2021
 
1981
2022
#ifdef DEBUG
2000
2041
}
2001
2042
#endif
2002
2043
 
2003
 
#ifdef DEBUG
2004
 
void
2005
 
verify_old_heap(Process* p)
2006
 
{
2007
 
    Eterm* o_hp = OLD_HEAP(p);
2008
 
    Eterm* o_htop = OLD_HTOP(p);
2009
 
    char* nh = (char *) HEAP_START(p);
2010
 
    Uint nh_size = (char *) HEAP_TOP(p) - nh;
2011
 
    char* oh = (char *) OLD_HEAP(p);
2012
 
    Uint oh_size = (char *) OLD_HTOP(p) - oh;
2013
 
    Eterm** ssb_start = NULL;
2014
 
    Eterm** limit = NULL;
2015
 
    
2016
 
    if (p->ssb != NULL) {
2017
 
        ssb_start = p->ssb->buf;
2018
 
        limit = p->ssb->next;
2019
 
    }
2020
 
    
2021
 
    while (o_hp != o_htop) {
2022
 
        Eterm* ptr;
2023
 
        Eterm val;
2024
 
        Eterm gval = *o_hp;
2025
 
 
2026
 
        switch (primary_tag(gval)) {
2027
 
        case TAG_PRIMARY_BOXED: {
2028
 
            ptr = boxed_val(gval);
2029
 
            if (!in_area(ptr,oh,oh_size)) {
2030
 
                Eterm** ssb_p = ssb_start;
2031
 
                if (in_area(ptr,nh,nh_size)) {
2032
 
                    while (ssb_p < limit) {
2033
 
                        if (o_hp == *ssb_p) {
2034
 
                            break;
2035
 
                        }
2036
 
                        ssb_p++;
2037
 
                    }
2038
 
                    ASSERT(ssb_p < limit);
2039
 
                }
2040
 
            }
2041
 
            val = *ptr;
2042
 
            ASSERT(is_header(val));
2043
 
            o_hp++;
2044
 
            break;
2045
 
        }
2046
 
        case TAG_PRIMARY_LIST: {
2047
 
            ptr = list_val(gval);
2048
 
            if (!in_area(ptr,oh,oh_size)) {
2049
 
                Eterm** ssb_p = ssb_start;
2050
 
                if (in_area(ptr,nh,nh_size)) {
2051
 
                    while (ssb_p < limit) {
2052
 
                        if (o_hp == *ssb_p) {
2053
 
                            break;
2054
 
                        }
2055
 
                        ssb_p++;
2056
 
                    }
2057
 
                    ASSERT(ssb_p < limit);
2058
 
                }
2059
 
            }
2060
 
            val = *ptr;
2061
 
            ASSERT(is_value(val));
2062
 
            o_hp++;
2063
 
            break;
2064
 
        }
2065
 
        case TAG_PRIMARY_HEADER: {
2066
 
            if (header_is_thing(gval))
2067
 
                o_hp += (thing_arityval(gval)+1);
2068
 
            else
2069
 
                o_hp++;
2070
 
            break;
2071
 
        }
2072
 
        default:
2073
 
            ASSERT(is_value(gval));
2074
 
            o_hp++;
2075
 
            break;
2076
 
        }
2077
 
    }
2078
 
}
2079
 
#endif
2080
 
 
2081
 
/*
2082
 
 * Sequential Store Buffer (write barrier) stuff.
2083
 
 */
2084
 
 
2085
 
void
2086
 
erts_ensure_ssb(Process* p)
2087
 
{
2088
 
    ErlSSB* ssb;
2089
 
    Uint avail = 64;
2090
 
 
2091
 
    if (p->ssb == NULL) {
2092
 
        ssb = (ErlSSB *) erts_alloc(ERTS_ALC_T_SSB,
2093
 
                                    sizeof(ErlSSB) + sizeof(Eterm)*avail);
2094
 
        ssb->next = ssb->buf;
2095
 
        ssb->end = ssb->buf + avail;
2096
 
        p->ssb = ssb;
2097
 
    }
2098
 
}
2099
 
 
2100
 
void
2101
 
erts_ssb_expand_put(Process* p, Eterm* addr)
2102
 
{
2103
 
    Uint old_sz;
2104
 
    Uint new_sz;
2105
 
 
2106
 
    old_sz = (p->ssb->end - p->ssb->buf);
2107
 
    new_sz = 2*old_sz;
2108
 
    p->ssb = (ErlSSB *) erts_realloc(ERTS_ALC_T_SSB,
2109
 
                                     (void *)p->ssb,
2110
 
                                     sizeof(ErlSSB)+new_sz*sizeof(Eterm *));
2111
 
    p->ssb->next = p->ssb->buf + old_sz;
2112
 
    p->ssb->end = p->ssb->buf + new_sz;
2113
 
    *(p)->ssb->next++ = addr;
2114
 
}
2115
 
 
2116
 
/*
2117
 
 * Get rid from the SSB all pointers that don't point into the old_heap.
2118
 
 */
2119
 
static void
2120
 
ssb_filter(Process* p)
2121
 
{
2122
 
    char* oh = (char *) OLD_HEAP(p);
2123
 
    Uint oh_size = (char *) OLD_HTOP(p) - oh;
2124
 
    Eterm** limit = p->ssb->next;
2125
 
    Eterm** ssb_p = p->ssb->buf;
2126
 
 
2127
 
    while (ssb_p < limit) {
2128
 
        Eterm* ptr = *ssb_p;
2129
 
        if (!in_area(ptr, oh, oh_size)) {
2130
 
            limit--;
2131
 
            *ssb_p = *limit;
2132
 
            continue;
2133
 
        }
2134
 
        ssb_p++;
2135
 
    }
2136
 
    p->ssb->next = limit;
2137
 
}
2138
 
 
2139
2044
#endif /* HEAP_FRAG_ELIM_TEST */