← Back to branch summary

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

« back to all changes in this revision

Viewing changes to erts/emulator/beam/erl_debug.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_debug.c
23
23
#include "erl_vm.h"
24
24
#include "global.h"
25
25
#include "erl_process.h"
 
26
#include "erl_nmgc.h"
26
27
#include "big.h"
27
28
#include "bif.h"
28
29
#include "beam_catches.h"
 
30
#include "erl_debug.h"
 
31
#include "ggc.h"
29
32
 
30
33
#define WITHIN(ptr, x, y) ((x) <= (ptr) && (ptr) < (y))
31
34
 
32
 
#define IN_HEAP(p, ptr) \
33
 
   (WITHIN((ptr), p->heap, p->hend) || (OLD_HEAP(p) && \
34
 
       WITHIN((ptr), OLD_HEAP(p), OLD_HEND(p))))
 
35
#if defined(HYBRID)
 
36
#if defined(INCREMENTAL)
 
37
/* Hybrid + Incremental */
 
38
#define IN_HEAP(p, ptr)                                                 \
 
39
    (WITHIN((ptr), p->heap, p->hend) ||                                 \
 
40
     (OLD_HEAP(p) && WITHIN((ptr), OLD_HEAP(p), OLD_HEND(p))) ||        \
 
41
     WITHIN((ptr), global_heap, global_hend) ||                         \
 
42
     (inc_fromspc && WITHIN((ptr), inc_fromspc, inc_fromend)) ||        \
 
43
     WITHIN((ptr), global_old_heap, global_old_hend))
 
44
 
 
45
#define IN_MA(ptr)                                                      \
 
46
    (WITHIN((ptr), global_heap, global_hend) ||                         \
 
47
     (inc_fromspc && WITHIN((ptr), inc_fromspc, inc_fromend)) ||        \
 
48
     WITHIN((ptr), global_old_heap, global_old_hend))
 
49
#else
 
50
/* Hybrid */
 
51
#define IN_HEAP(p, ptr)                                                 \
 
52
    (WITHIN((ptr), p->heap, p->hend) ||                                 \
 
53
     (OLD_HEAP(p) && WITHIN((ptr), OLD_HEAP(p), OLD_HEND(p))) ||        \
 
54
     WITHIN((ptr), global_heap, global_hend) ||                         \
 
55
     (global_old_heap && WITHIN((ptr),global_old_heap,global_old_hend)))
 
56
#endif
 
57
#else
 
58
/* Private */
 
59
#define IN_HEAP(p, ptr)                                                 \
 
60
    (WITHIN((ptr), p->heap, p->hend) ||                                 \
 
61
     (OLD_HEAP(p) && WITHIN((ptr), OLD_HEAP(p), OLD_HEND(p))))
 
62
#endif
 
63
 
 
64
 
 
65
#ifdef __GNUC__
 
66
/*
 
67
 * Does not work in Microsoft C. Since this is debugging code that will
 
68
 * hardly be used on Windows, get rid of it unless we have Gnu compiler.
 
69
 */
 
70
#define PTR_SIZE 2*(int)sizeof(long)
 
71
 
 
72
static const char dashes[PTR_SIZE+3] = {
 
73
    [0 ... PTR_SIZE+1] = '-'
 
74
};
 
75
#endif
 
76
 
 
77
#ifdef DEBUG
35
78
 
36
79
/*
37
80
 * This file defines functions for use within a debugger like gdb
40
83
 
41
84
void pps(Process*, Eterm*);
42
85
void ptd(Process*, Eterm);
43
 
void paranoid_display(Process*, Eterm, CIO);
44
 
 
 
86
void paranoid_display(int, void*, Process*, Eterm);
45
87
static int dcount;
46
88
 
47
 
static int pdisplay1(Process* p, Eterm obj, CIO fd);
 
89
static int pdisplay1(int to, void *to_arg, Process* p, Eterm obj);
48
90
 
49
91
void ptd(Process* p, Eterm x) 
50
92
{
51
 
    pdisplay1(p, x, CERR);
52
 
    erl_putc('\n', CERR);
 
93
    pdisplay1(ERTS_PRINT_STDERR, NULL, p, x);
 
94
    erts_putc(ERTS_PRINT_STDERR, NULL, '\n');
53
95
}
54
96
 
55
97
/*
58
100
 */
59
101
 
60
102
void
61
 
paranoid_display(Process* p, Eterm obj, CIO fd)
 
103
paranoid_display(int to, void *to_arg, Process* p, Eterm obj)
62
104
{
63
105
    dcount = 100000;
64
 
    pdisplay1(p, obj, fd);
 
106
    pdisplay1(to, to_arg, p, obj);
65
107
}
66
108
 
67
109
static int
68
 
pdisplay1(Process* p, Eterm obj, CIO fd)
 
110
pdisplay1(int to, void *to_arg, Process* p, Eterm obj)
69
111
{
70
112
    int i, k;
71
113
    Eterm* nobj;
74
116
        return(1);
75
117
 
76
118
    if (is_CP(obj)) {
77
 
        erl_printf(fd, "<cp/header:%08X", obj);
 
119
        erts_print(to, to_arg, "<cp/header:%0*lX",PTR_SIZE,obj);
78
120
        return 0;
79
121
    }
80
122
 
81
123
    switch (tag_val_def(obj)) {
82
124
    case NIL_DEF:
83
 
        erl_printf(fd, "[]");
 
125
        erts_print(to, to_arg, "[]");
84
126
        break;
85
127
    case ATOM_DEF:
86
 
        print_atom((int)atom_val(obj), fd);
 
128
        erts_print(to, to_arg, "%T", obj);
87
129
        break;
88
130
    case SMALL_DEF:
89
 
        erl_printf(fd, "%d", signed_val(obj));
 
131
        erts_print(to, to_arg, "%ld", signed_val(obj));
90
132
        break;
91
133
 
92
134
    case BIG_DEF:
93
135
        nobj = big_val(obj);
94
136
        if (!IN_HEAP(p, nobj)) {
95
 
            erl_printf(fd, "#<bad big %X>#", obj);
 
137
            erts_print(to, to_arg, "#<bad big %X>#", obj);
96
138
            return 1;
97
139
        }
98
140
 
99
141
        i = BIG_SIZE(nobj);
100
142
        if (BIG_SIGN(nobj))
101
 
            erl_printf(fd, "-#integer(%d) = {", i);
 
143
            erts_print(to, to_arg, "-#integer(%d) = {", i);
102
144
        else
103
 
            erl_printf(fd, "#integer(%d) = {", i);
104
 
        erl_printf(fd, "%d", BIG_DIGIT(nobj, 0));
 
145
            erts_print(to, to_arg, "#integer(%d) = {", i);
 
146
        erts_print(to, to_arg, "%d", BIG_DIGIT(nobj, 0));
105
147
        for (k = 1; k < i; k++)
106
 
            erl_printf(fd, ",%d", BIG_DIGIT(nobj, k));
107
 
        erl_putc('}', fd);
 
148
            erts_print(to, to_arg, ",%d", BIG_DIGIT(nobj, k));
 
149
        erts_putc(to, to_arg, '}');
108
150
        break;
109
151
    case REF_DEF:
110
152
    case EXTERNAL_REF_DEF: {
111
153
        Uint32 *ref_num;
112
 
        erl_printf(fd, "#Ref<%lu", ref_channel_no(obj));
 
154
        erts_print(to, to_arg, "#Ref<%lu", ref_channel_no(obj));
113
155
        ref_num = ref_numbers(obj);
114
156
        for (i = ref_no_of_numbers(obj)-1; i >= 0; i--)
115
 
            erl_printf(fd, ",%lu", ref_num[i]);
116
 
        erl_printf(fd, ">");
 
157
            erts_print(to, to_arg, ",%lu", ref_num[i]);
 
158
        erts_print(to, to_arg, ">");
117
159
        break;
118
160
    }
119
161
    case PID_DEF:
120
162
    case EXTERNAL_PID_DEF:
121
 
        erl_printf(fd, "<%lu.%lu.%lu>",
 
163
        erts_print(to, to_arg, "<%lu.%lu.%lu>",
122
164
                   pid_channel_no(obj),
123
165
                   pid_number(obj),
124
166
                   pid_serial(obj));
125
167
        break;
126
168
    case PORT_DEF:
127
169
    case EXTERNAL_PORT_DEF:
128
 
        erl_printf(fd, "#Port<%lu.%lu>",
 
170
        erts_print(to, to_arg, "#Port<%lu.%lu>",
129
171
                   port_channel_no(obj),
130
172
                   port_number(obj));
131
173
        break;
132
174
    case LIST_DEF:
133
 
        erl_putc('[', fd);
 
175
        erts_putc(to, to_arg, '[');
134
176
        nobj = list_val(obj);
135
177
        while (1) {
136
178
            if (!IN_HEAP(p, nobj)) {
137
 
                erl_printf(fd, "#<bad list %X>", obj);
 
179
                erts_print(to, to_arg, "#<bad list %X>", obj);
138
180
                return 1;
139
181
            }
140
 
            if (pdisplay1(p, *nobj++, fd) != 0)
 
182
            if (pdisplay1(to, to_arg, p, *nobj++) != 0)
141
183
                return(1);
142
184
            if (is_not_list(*nobj))
143
185
                break;
144
 
            erl_putc(',', fd);
 
186
            erts_putc(to, to_arg, ',');
145
187
            nobj = list_val(*nobj);
146
188
        }
147
189
        if (is_not_nil(*nobj)) {
148
 
            erl_putc('|', fd);
149
 
            if (pdisplay1(p, *nobj, fd) != 0)
 
190
            erts_putc(to, to_arg, '|');
 
191
            if (pdisplay1(to, to_arg, p, *nobj) != 0)
150
192
                return(1);
151
193
        }
152
 
        erl_putc(']', fd);
 
194
        erts_putc(to, to_arg, ']');
153
195
        break;
154
196
    case TUPLE_DEF:
155
197
        nobj = tuple_val(obj);  /* pointer to arity */
156
198
        i = arityval(*nobj);    /* arity */
157
 
        erl_putc('{', fd);
 
199
        erts_putc(to, to_arg, '{');
158
200
        while (i--) {
159
 
            if (pdisplay1(p, *++nobj,fd) != 0) return(1);
160
 
            if (i >= 1) erl_putc(',',fd);
 
201
            if (pdisplay1(to, to_arg, p, *++nobj) != 0) return(1);
 
202
            if (i >= 1) erts_putc(to, to_arg, ',');
161
203
        }
162
 
        erl_putc('}',fd);
 
204
        erts_putc(to, to_arg, '}');
163
205
        break;
164
206
    case FLOAT_DEF: {
165
207
            FloatDef ff;
166
208
            GET_DOUBLE(obj, ff);
167
209
#ifdef _OSE_
168
 
            erl_printf(fd, "%e", ff.fd);
 
210
            erts_print(to, to_arg, "%e", ff.fd);
169
211
#else
170
 
            erl_printf(fd, "%.20e", ff.fd);
 
212
            erts_print(to, to_arg, "%.20e", ff.fd);
171
213
#endif
172
214
        }
173
215
        break;
174
216
    case BINARY_DEF:
175
 
        erl_printf(fd, "#Bin");
 
217
        erts_print(to, to_arg, "#Bin");
176
218
        break;
177
219
    default:
178
 
        erl_printf(fd, "unknown object %x", obj);
 
220
        erts_print(to, to_arg, "unknown object %x", obj);
179
221
    }
180
222
    return(0);
181
223
}
183
225
void
184
226
pps(Process* p, Eterm* stop)
185
227
{
 
228
    int to = ERTS_PRINT_STDOUT;
 
229
    void *to_arg = NULL;
186
230
    Eterm* sp = STACK_START(p) - 1;
187
231
 
188
232
    if (stop <= STACK_END(p)) {
190
234
    }
191
235
 
192
236
    while(sp >= stop) {
193
 
        erl_printf(COUT,"%08lx: ", (Eterm) sp);
 
237
        erts_print(to, to_arg, "%0*lx: ", PTR_SIZE, (Eterm) sp);
194
238
        if (is_catch(*sp)) {
195
 
            erl_printf(COUT, "catch %d", (Uint)catch_pc(*sp));
 
239
            erts_print(to, to_arg, "catch %d", (Uint)catch_pc(*sp));
196
240
        } else {
197
 
            paranoid_display(p, *sp, COUT);
 
241
            paranoid_display(to, to_arg, p, *sp);
198
242
        }
199
 
        erl_putc('\r', COUT);
200
 
        erl_putc('\n', COUT);
 
243
        erts_putc(to, to_arg, '\n');
201
244
        sp--;
202
245
    }
203
246
}
 
247
 
 
248
#endif /* DEBUG */
 
249
 
 
250
static int verify_eterm(Process *p,Eterm element);
 
251
static int verify_eterm(Process *p,Eterm element)
 
252
{
 
253
    Eterm *ptr;
 
254
    ErlHeapFragment* mbuf;
 
255
 
 
256
    switch (primary_tag(element)) {
 
257
        case TAG_PRIMARY_LIST: ptr = list_val(element); break;
 
258
        case TAG_PRIMARY_BOXED: ptr = boxed_val(element); break;
 
259
        default: /* Immediate or header/cp */ return 1;
 
260
    }
 
261
 
 
262
    if (p) {
 
263
        if (IN_HEAP(p, ptr))
 
264
            return 1;
 
265
 
 
266
        for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next) {
 
267
            if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->size)) {
 
268
                return 1;
 
269
            }
 
270
        }
 
271
    }
 
272
#ifdef INCREMENTAL
 
273
    else {
 
274
        if (IN_MA(ptr))
 
275
            return 1;
 
276
    }
 
277
#endif
 
278
 
 
279
    return 0;
 
280
}
 
281
 
 
282
void erts_check_stack(Process *p)
 
283
{
 
284
    Eterm *elemp;
 
285
    Eterm *stack_start = p->heap + p->heap_sz;
 
286
    Eterm *stack_end = p->htop;
 
287
 
 
288
    if (p->stop > stack_start)
 
289
        erl_exit(1,
 
290
                 "<%lu.%lu.%lu>: Stack underflow\n",
 
291
                 internal_pid_channel_no(p->id),
 
292
                 internal_pid_number(p->id),
 
293
                 internal_pid_serial(p->id));
 
294
 
 
295
    if (p->stop < stack_end)
 
296
        erl_exit(1,
 
297
                 "<%lu.%lu.%lu>: Stack overflow\n",
 
298
                 internal_pid_channel_no(p->id),
 
299
                 internal_pid_number(p->id),
 
300
                 internal_pid_serial(p->id));
 
301
 
 
302
    for (elemp = p->stop; elemp < stack_start; elemp++) {
 
303
        int in_mbuf = 0;
 
304
        Eterm *ptr;
 
305
        ErlHeapFragment* mbuf;
 
306
        switch (primary_tag(*elemp)) {
 
307
        case TAG_PRIMARY_LIST: ptr = list_val(*elemp); break;
 
308
        case TAG_PRIMARY_BOXED: ptr = boxed_val(*elemp); break;
 
309
        default: /* Immediate or cp */ continue;
 
310
        }
 
311
        if (IN_HEAP(p, ptr))
 
312
            continue;
 
313
        for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next)
 
314
            if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->size)) {
 
315
                in_mbuf = 1;
 
316
                break;
 
317
            }
 
318
        if (in_mbuf)
 
319
            continue;
 
320
 
 
321
        erl_exit(1,
 
322
                 "<%lu.%lu.%lu>: Wild stack pointer\n",
 
323
                 internal_pid_channel_no(p->id),
 
324
                 internal_pid_number(p->id),
 
325
                 internal_pid_serial(p->id));
 
326
    }
 
327
 
 
328
}
 
329
 
 
330
#if defined(CHECK_FOR_HOLES)
 
331
static void check_memory(Eterm *start, Eterm *end);
 
332
 
 
333
void erts_check_for_holes(Process* p)
 
334
{
 
335
    ErlHeapFragment* hf;
 
336
    Eterm* start;
 
337
 
 
338
    start = p->last_htop ? p->last_htop : HEAP_START(p);
 
339
    check_memory(start, HEAP_TOP(p));
 
340
    p->last_htop = HEAP_TOP(p);
 
341
 
 
342
    for (hf = MBUF(p); hf != 0; hf = hf->next) {
 
343
#if !defined(HEAP_FRAG_ELIM_TEST)
 
344
        if (ARITH_HEAP(p) - hf->mem < (unsigned long)hf->size) {
 
345
            check_memory(hf->mem, ARITH_HEAP(p));
 
346
            if (hf == p->last_mbuf) {
 
347
                break;
 
348
            }
 
349
        } else {
 
350
#endif
 
351
            if (hf == p->last_mbuf) {
 
352
                break;
 
353
            }
 
354
            check_memory(hf->mem, hf->mem+hf->size);
 
355
#if !defined(HEAP_FRAG_ELIM_TEST)
 
356
        }
 
357
#endif
 
358
    }
 
359
    p->last_mbuf = MBUF(p);
 
360
}
 
361
 
 
362
static void check_memory(Eterm *start, Eterm *end)
 
363
{
 
364
    Eterm *pos = start;
 
365
 
 
366
    while (pos < end) {
 
367
        Eterm hval = *pos++;
 
368
 
 
369
        if (hval == ERTS_HOLE_MARKER) {
 
370
            erts_fprintf(stderr,"%s, line %d: ERTS_HOLE_MARKER found at 0x%0*lx\n",
 
371
                         __FILE__, __LINE__,PTR_SIZE,(unsigned long)(pos-1));
 
372
            print_untagged_memory(start,end); /* DEBUGSTUFF */
 
373
            abort();
 
374
        } else if (is_thing(hval)) {
 
375
            pos += (thing_arityval(hval));
 
376
        }
 
377
    }
 
378
}
 
379
#endif
 
380
 
 
381
#ifdef __GNUC__
 
382
 
 
383
/*
 
384
 * erts_check_heap and erts_check_memory will run through the heap
 
385
 * silently if everything is ok.  If there are strange (untagged) data
 
386
 * in the heap or wild pointers, the system will be halted with an
 
387
 * error message.
 
388
 */
 
389
void erts_check_heap(Process *p)
 
390
{
 
391
    ErlHeapFragment* bp = MBUF(p);
 
392
 
 
393
    erts_check_memory(p,HEAP_START(p),HEAP_TOP(p));
 
394
    if (OLD_HEAP(p) != NULL) {
 
395
        erts_check_memory(p,OLD_HEAP(p),OLD_HTOP(p));
 
396
    }
 
397
 
 
398
    while (bp) {
 
399
#if !defined(HEAP_FRAG_ELIM_TEST)
 
400
        if ((ARITH_HEAP(p) >= bp->mem) &&
 
401
            (ARITH_HEAP(p) < bp->mem + bp->size)) {
 
402
            erts_check_memory(p,bp->mem,ARITH_HEAP(p));
 
403
        } else {
 
404
#endif
 
405
            erts_check_memory(p,bp->mem,bp->mem + bp->size);
 
406
#if !defined(HEAP_FRAG_ELIM_TEST)
 
407
        }
 
408
#endif
 
409
        bp = bp->next;
 
410
    }
 
411
}
 
412
 
 
413
void erts_check_memory(Process *p, Eterm *start, Eterm *end)
 
414
{
 
415
    Eterm *pos = start;
 
416
 
 
417
    while (pos < end) {
 
418
        Eterm hval = *pos++;
 
419
 
 
420
#ifdef DEBUG
 
421
        if (hval == ARITH_MARKER) {
 
422
            erl_exit(1, "ARITH_MARKER in heap fragment @ 0x%0*lx!\n",
 
423
                     PTR_SIZE,(unsigned long)(pos - 1));
 
424
        }
 
425
        else if (hval == DEBUG_BAD_WORD) {
 
426
            print_untagged_memory(start, end);
 
427
            erl_exit(1, "Uninitialized HAlloc'ed memory found @ 0x%0*lx!\n",
 
428
                     PTR_SIZE,(unsigned long)(pos - 1));
 
429
        }
 
430
#endif
 
431
 
 
432
        if(is_thing(hval)) {
 
433
            pos += thing_arityval(hval);
 
434
            continue;
 
435
        }
 
436
 
 
437
        if (verify_eterm(p,hval))
 
438
            continue;
 
439
 
 
440
        erl_exit(1, "Wild pointer found @ 0x%0*lx!\n",
 
441
                 PTR_SIZE,(unsigned long)(pos - 1));
 
442
    }
 
443
}
 
444
 
 
445
void verify_process(Process *p)
 
446
{
 
447
#define VERIFY_AREA(name,ptr,sz) {                                      \
 
448
    int n = (sz);                                                       \
 
449
    while (n--) if(!verify_eterm(p,*(ptr+n)))                           \
 
450
        erl_exit(1,"Wild pointer found in " name " of %T!\n",p->id); }
 
451
 
 
452
#define VERIFY_ETERM(name,eterm) {                                      \
 
453
    if(!verify_eterm(p,eterm))                                          \
 
454
        erl_exit(1,"Wild pointer found in " name " of %T!\n",p->id); }
 
455
 
 
456
 
 
457
    ErlMessage* mp = p->msg.first;
 
458
 
 
459
    VERBOSE(DEBUG_MEMORY,("Verify process: %T...\n",p->id));
 
460
 
 
461
    while (mp != NULL) {
 
462
        VERIFY_ETERM("message term",ERL_MESSAGE_TERM(mp));
 
463
        VERIFY_ETERM("message token",ERL_MESSAGE_TOKEN(mp));
 
464
        mp = mp->next;
 
465
    }
 
466
 
 
467
    erts_check_stack(p);
 
468
    erts_check_heap(p);
 
469
 
 
470
    if (p->dictionary)
 
471
        VERIFY_AREA("dictionary",p->dictionary->data, p->dictionary->used);
 
472
    if (p->debug_dictionary)
 
473
        VERIFY_AREA("debug dictionary",p->debug_dictionary->data,
 
474
                    p->debug_dictionary->used);
 
475
    VERIFY_ETERM("seq trace token",p->seq_trace_token);
 
476
    VERIFY_ETERM("group leader",p->group_leader);
 
477
    VERIFY_ETERM("fvalue",p->fvalue);
 
478
    VERIFY_ETERM("ftrace",p->ftrace);
 
479
 
 
480
#ifdef HYBRID
 
481
    VERIFY_AREA("rrma",p->rrma,p->nrr);
 
482
#endif
 
483
 
 
484
    VERBOSE(DEBUG_MEMORY,("...done\n"));
 
485
 
 
486
#undef VERIFY_AREA
 
487
#undef VERIFY_ETERM
 
488
}
 
489
 
 
490
void verify_everything()
 
491
{
 
492
#ifdef HYBRID
 
493
    Uint i;
 
494
    Uint n = erts_num_active_procs;
 
495
 
 
496
#ifdef INCREMENTAL_FREE_SIZES_NEEDS_TO_BE_TAGGED_AS_HEADERS_WITH_ARITY
 
497
    INC_Page *page = inc_used_mem;
 
498
#endif
 
499
 
 
500
    for (i = 0; i < n; i++) {
 
501
        verify_process(erts_active_procs[i]);
 
502
    }
 
503
 
 
504
    erts_check_memory(NULL,global_heap,global_htop);
 
505
 
 
506
#ifdef INCREMENTAL_FREE_SIZES_NEEDS_TO_BE_TAGGED_AS_HEADERS_WITH_ARITY
 
507
    while (page)
 
508
    {
 
509
        Eterm *end = page + INC_PAGE_SIZE;
 
510
        Eterm *pos = page->start;
 
511
 
 
512
        while( pos <  end) {
 
513
            Eterm val = *pos++;
 
514
            if(is_header(val))
 
515
                pos += thing_arityval(val);
 
516
            else
 
517
                verify_eterm(NULL,val);
 
518
        }
 
519
        page = page->next;
 
520
    }
 
521
#endif
 
522
#endif /* HYBRID */
 
523
}
 
524
 
 
525
/*
 
526
 * print_untagged_memory will print the contents of given memory area.
 
527
 */
 
528
void print_untagged_memory(Eterm *pos, Eterm *end)
 
529
{
 
530
    int i = 0;
 
531
    erts_printf("| %*s   | Range: 0x%0*lx - 0x%0*lx%*s|\n",
 
532
                PTR_SIZE, "",
 
533
                PTR_SIZE,(unsigned long)pos,
 
534
                PTR_SIZE,(unsigned long)(end - 1),2 * PTR_SIZE - 2,"");
 
535
    erts_printf("| %-*s | %-*s |\n",PTR_SIZE+2,"Address",
 
536
                4*PTR_SIZE+11,"Contents");
 
537
    erts_printf("|-%s-|-%s-%s-%s-%s-|\n",dashes,dashes,dashes,dashes,dashes);
 
538
    while( pos < end ) {
 
539
        if (i == 0)
 
540
            erts_printf("| 0x%0*lx | ", PTR_SIZE, (unsigned long)pos);
 
541
        erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)*pos);
 
542
        pos++; i++;
 
543
        if (i == 4) {
 
544
            erts_printf("|\n");
 
545
            i = 0;
 
546
        }
 
547
    }
 
548
    while (i && i < 4) {
 
549
        erts_printf("%*s",PTR_SIZE+3,"");
 
550
        i++;
 
551
    }
 
552
    if (i != 0)
 
553
        erts_printf("|\n");
 
554
    erts_printf("+-%s-+-%s-%s-%s-%s-+\n",dashes,dashes,dashes,dashes,dashes);
 
555
}
 
556
 
 
557
/*
 
558
 * print_tagged_memory will print contents of given memory area and
 
559
 * display it as if it was tagged Erlang terms (which it hopefully
 
560
 * is).  This function knows about forwarding pointers to be able to
 
561
 * print a heap during garbage collection. erts_printf("%T",val)
 
562
 * do not know about forwarding pointers though, so it will still
 
563
 * crash if they are encoutered...
 
564
 */
 
565
void print_tagged_memory(Eterm *pos, Eterm *end)
 
566
{
 
567
    erts_printf("+-%s-+-%s-+\n",dashes,dashes);
 
568
    erts_printf("| 0x%0*lx - 0x%0*lx |\n",
 
569
                PTR_SIZE,(unsigned long)pos,
 
570
                PTR_SIZE,(unsigned long)(end - 1));
 
571
    erts_printf("| %-*s   | %-*s   |\n",PTR_SIZE,"Address",PTR_SIZE,"Contents");
 
572
    erts_printf("|-%s-|-%s-|\n",dashes,dashes);
 
573
    while( pos < end ) {
 
574
        Eterm val = pos[0];
 
575
        erts_printf("| 0x%0*lx | 0x%0*lx | ",
 
576
                    PTR_SIZE,(unsigned long)pos, PTR_SIZE,(unsigned long)val);
 
577
        ++pos;
 
578
        if( is_arity_value(val) ) {
 
579
            erts_printf("Arity(%lu)", arityval(val));
 
580
        } else if( is_thing(val) ) {
 
581
            unsigned int ari = thing_arityval(val);
 
582
            erts_printf("Thing Arity(%u) Tag(%lu)", ari, thing_subtag(val));
 
583
            while( ari ) {
 
584
                erts_printf("\n| 0x%0*lx | 0x%0*lx | THING",
 
585
                            PTR_SIZE, (unsigned long)pos,
 
586
                            PTR_SIZE, (unsigned long)*pos);
 
587
                ++pos;
 
588
                --ari;
 
589
            }
 
590
        } else {
 
591
            switch (primary_tag(val)) {
 
592
            case TAG_PRIMARY_BOXED:
 
593
                if (!is_header(*boxed_val(val))) {
 
594
                    erts_printf("Moved -> 0x%0*lx\n",PTR_SIZE,
 
595
                                (unsigned long)*boxed_val(val));
 
596
                    continue;
 
597
                }
 
598
                break;
 
599
 
 
600
            case TAG_PRIMARY_LIST:
 
601
                if (is_non_value(*list_val(val))) {
 
602
                    erts_printf("Moved -> 0x%0*lx\n",PTR_SIZE,
 
603
                                (unsigned long)*(list_val(val) + 1));
 
604
                    continue;
 
605
                }
 
606
                break;
 
607
            }
 
608
            erts_printf("%.30T", val);
 
609
        }
 
610
        erts_printf("\n");
 
611
    }
 
612
    erts_printf("+-%s-+-%s-+\n",dashes,dashes);
 
613
}
 
614
 
 
615
#ifdef HYBRID
 
616
void print_ma_info(void)
 
617
{
 
618
    erts_printf("Message Area (start - top - end): "
 
619
                "0x%0*lx - 0x%0*lx - 0x%0*lx\n",
 
620
                PTR_SIZE, (unsigned long)global_heap,
 
621
                PTR_SIZE, (unsigned long)global_htop,
 
622
                PTR_SIZE, (unsigned long)global_hend);
 
623
#ifndef INCREMENTAL
 
624
    erts_printf("  High water: 0x%0*lx   "
 
625
                "Old gen: 0x%0*lx - 0x%0*lx - 0x%0*lx\n",
 
626
                PTR_SIZE, (unsigned long)global_high_water,
 
627
                PTR_SIZE, (unsigned long)global_old_heap,
 
628
                PTR_SIZE, (unsigned long)global_old_htop,
 
629
                PTR_SIZE, (unsigned long)global_old_hend);
 
630
#endif
 
631
}
 
632
 
 
633
void print_message_area(void)
 
634
{
 
635
    Eterm *pos = global_heap;
 
636
    Eterm *end = global_htop;
 
637
 
 
638
    erts_printf("From: 0x%0*lx  to  0x%0*lx\n",
 
639
                PTR_SIZE,(unsigned long)pos,PTR_SIZE,(unsigned long)end);
 
640
    erts_printf("(Old generation: 0x%0*lx  to 0x%0*lx\n",
 
641
                PTR_SIZE, (unsigned long)global_old_heap,
 
642
                PTR_SIZE, (unsigned long)global_old_hend);
 
643
    erts_printf("| %-*s | %-*s |\n",PTR_SIZE,"Address",PTR_SIZE,"Contents");
 
644
    erts_printf("|-%s-|-%s-|\n",dashes,dashes);
 
645
    while( pos < end ) {
 
646
        Eterm val = pos[0];
 
647
        erts_printf("| 0x%0*lx | 0x%0*lx | ",
 
648
                    PTR_SIZE,(unsigned long)pos,PTR_SIZE,(unsigned long)val);
 
649
        ++pos;
 
650
        if( is_arity_value(val) ) {
 
651
            erts_printf("Arity(%lu)", arityval(val));
 
652
        } else if( is_thing(val) ) {
 
653
            unsigned int ari = thing_arityval(val);
 
654
            erts_printf("Thing Arity(%u) Tag(%lu)", ari, thing_subtag(val));
 
655
            while( ari ) {
 
656
                erts_printf("\n| 0x%0*lx | 0x%0*lx | THING",
 
657
                            PTR_SIZE, (unsigned long)pos,
 
658
                            PTR_SIZE, (unsigned long)*pos);
 
659
                ++pos;
 
660
                --ari;
 
661
            }
 
662
        } else
 
663
            erts_printf("%.30T", val);
 
664
        erts_printf("\n");
 
665
    }
 
666
    erts_printf("+-%s-+-%s-+\n",dashes,dashes);
 
667
}
 
668
 
 
669
void check_message_area()
 
670
{
 
671
    Eterm *pos = global_heap;
 
672
    Eterm *end = global_htop;
 
673
 
 
674
    while( pos < end ) {
 
675
        Eterm val = *pos++;
 
676
        if(is_header(val))
 
677
            pos += thing_arityval(val);
 
678
        else if(!is_immed(val))
 
679
            if ((ptr_val(val) < global_heap || ptr_val(val) >= global_htop) &&
 
680
                (ptr_val(val) < global_old_heap ||
 
681
                 ptr_val(val) >= global_old_hend))
 
682
            {
 
683
                erts_printf("check_message_area: Stray pointer found\n");
 
684
                print_message_area();
 
685
                erts_printf("Crashing to make it look real...\n");
 
686
                pos = 0;
 
687
            }
 
688
    }
 
689
}
 
690
#endif /* HYBRID */
 
691
 
 
692
static void print_process_memory(Process *p);
 
693
static void print_process_memory(Process *p)
 
694
{
 
695
    ErlHeapFragment* bp = MBUF(p);
 
696
 
 
697
    erts_printf("==============================\n");
 
698
    erts_printf("|| Memory info for %T ||\n",p->id);
 
699
    erts_printf("==============================\n");
 
700
 
 
701
    erts_printf("-- %-*s ---%s-%s-%s-%s--\n",
 
702
                PTR_SIZE, "PCB", dashes, dashes, dashes, dashes);
 
703
 
 
704
    if (p->msg.first != NULL) {
 
705
        ErlMessage* mp;
 
706
        erts_printf("  Message Queue:\n");
 
707
        mp = p->msg.first;
 
708
        while (mp != NULL) {
 
709
            erts_printf("| 0x%0*lx | 0x%0*lx |\n",PTR_SIZE,
 
710
                        ERL_MESSAGE_TERM(mp),PTR_SIZE,ERL_MESSAGE_TOKEN(mp));
 
711
            mp = mp->next;
 
712
        }
 
713
    }
 
714
 
 
715
    if (p->dictionary != NULL) {
 
716
        int n = p->dictionary->used;
 
717
        Eterm *ptr = p->dictionary->data;
 
718
        erts_printf("  Dictionary: ");
 
719
        while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)ptr++);
 
720
        erts_printf("\n");
 
721
    }
 
722
 
 
723
    if (p->debug_dictionary != NULL) {
 
724
        int n = p->debug_dictionary->used;
 
725
        Eterm *ptr = p->debug_dictionary->data;
 
726
        erts_printf("  Debug Dictionary: ");
 
727
        while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)ptr++);
 
728
        erts_printf("\n");
 
729
    }
 
730
 
 
731
    if (p->arity > 0) {
 
732
        int n = p->arity;
 
733
        Eterm *ptr = p->arg_reg;
 
734
        erts_printf("  Argument Registers: ");
 
735
        while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)*ptr++);
 
736
        erts_printf("\n");
 
737
    }
 
738
 
 
739
    erts_printf("  Trace Token: 0x%0*lx\n",PTR_SIZE,p->seq_trace_token);
 
740
    erts_printf("  Group Leader: 0x%0*lx\n",PTR_SIZE,p->group_leader);
 
741
    erts_printf("  Fvalue: 0x%0*lx\n",PTR_SIZE,p->fvalue);
 
742
    erts_printf("  Ftrace: 0x%0*lx\n",PTR_SIZE,p->ftrace);
 
743
 
 
744
#ifdef HYBRID
 
745
    if (p->nrr > 0) {
 
746
        int i;
 
747
        erts_printf("  Remembered Roots:\n");
 
748
        for (i = 0; i < p->nrr; i++)
 
749
            if (p->rrsrc[i] != NULL)
 
750
                erts_printf("0x%0*lx -> 0x%0*lx\n",
 
751
                            PTR_SIZE, (unsigned long)p->rrsrc[i],
 
752
                            PTR_SIZE, (unsigned long)p->rrma[i]);
 
753
        erts_printf("\n");
 
754
    }
 
755
#endif
 
756
 
 
757
    erts_printf("+- %-*s -+ 0x%0*lx 0x%0*lx %s-%s-+\n",
 
758
                PTR_SIZE, "Stack",
 
759
                PTR_SIZE, (unsigned long)STACK_TOP(p),
 
760
                PTR_SIZE, (unsigned long)STACK_START(p),
 
761
                dashes, dashes);
 
762
    print_untagged_memory(STACK_TOP(p),STACK_START(p));
 
763
 
 
764
    erts_printf("+- %-*s -+ 0x%0*lx 0x%0*lx 0x%0*lx 0x%0*lx +\n",
 
765
                PTR_SIZE, "Heap",
 
766
                PTR_SIZE, (unsigned long)HEAP_START(p),
 
767
                PTR_SIZE, (unsigned long)HIGH_WATER(p),
 
768
                PTR_SIZE, (unsigned long)HEAP_TOP(p),
 
769
                PTR_SIZE, (unsigned long)HEAP_END(p));
 
770
    print_untagged_memory(HEAP_START(p),HEAP_TOP(p));
 
771
 
 
772
    if (OLD_HEAP(p)) {
 
773
        erts_printf("+- %-*s -+ 0x%0*lx 0x%0*lx 0x%0*lx %s-+\n",
 
774
                    PTR_SIZE, "Old Heap",
 
775
                    PTR_SIZE, (unsigned long)OLD_HEAP(p),
 
776
                    PTR_SIZE, (unsigned long)OLD_HTOP(p),
 
777
                    PTR_SIZE, (unsigned long)OLD_HEND(p),
 
778
                    dashes);
 
779
        print_untagged_memory(OLD_HEAP(p),OLD_HTOP(p));
 
780
    }
 
781
 
 
782
    if (bp)
 
783
        erts_printf("+- %-*s -+-%s-%s-%s-%s-+\n",
 
784
                    PTR_SIZE, "heap fragments",
 
785
                    dashes, dashes, dashes, dashes);
 
786
    while (bp) {
 
787
#if !defined(HEAP_FRAG_ELIM_TEST)
 
788
        if ((ARITH_HEAP(p) >= bp->mem) &&
 
789
            (ARITH_HEAP(p) < bp->mem + bp->size)) {
 
790
            print_untagged_memory(bp->mem,ARITH_HEAP(p));
 
791
        } else {
 
792
#endif
 
793
            print_untagged_memory(bp->mem,bp->mem + bp->size);
 
794
#if !defined(HEAP_FRAG_ELIM_TEST)
 
795
        }
 
796
#endif
 
797
        bp = bp->next;
 
798
    }
 
799
}
 
800
 
 
801
 
 
802
void print_memory(Process *p)
 
803
{
 
804
    if (p != NULL) {
 
805
        print_process_memory(p);
 
806
    }
 
807
#ifdef HYBRID
 
808
    else {
 
809
        Uint i;
 
810
        Uint n = erts_num_active_procs;
 
811
 
 
812
        for (i = 0; i < n; i++) {
 
813
            Process *p = erts_active_procs[i];
 
814
            print_process_memory(p);
 
815
        }
 
816
 
 
817
        erts_printf("==================\n");
 
818
        erts_printf("|| Message area ||\n");
 
819
        erts_printf("==================\n");
 
820
        erts_printf("+-%s-+-%s-%s-%s-%s-+\n",
 
821
                    dashes,dashes,dashes,dashes,dashes);
 
822
        erts_printf("| %-*s   | 0x%0*lx - 0x%0*lx - 0x%0*lx%*s|\n",
 
823
                    PTR_SIZE, "Young",
 
824
                    PTR_SIZE, (unsigned long)global_heap,
 
825
                    PTR_SIZE, (unsigned long)global_htop,
 
826
                    PTR_SIZE, (unsigned long)global_hend,
 
827
                    PTR_SIZE, "");
 
828
        erts_printf("+-%s-+-%s-%s-%s-%s-+\n",
 
829
                    dashes,dashes,dashes,dashes,dashes);
 
830
 
 
831
        print_untagged_memory(global_heap,global_htop);
 
832
 
 
833
 
 
834
        erts_printf("+-%s-+-%s-%s-%s-%s-+\n",
 
835
                    dashes,dashes,dashes,dashes,dashes);
 
836
        erts_printf("| %-*s   | 0x%0*lx - 0x%0*lx %*s    |\n",
 
837
                    PTR_SIZE, "Old",
 
838
                    PTR_SIZE, (unsigned long)global_old_heap,
 
839
                    PTR_SIZE, (unsigned long)global_old_hend,
 
840
                    2 * PTR_SIZE, "");
 
841
        erts_printf("+-%s-+-%s-%s-%s-%s-+\n",
 
842
                    dashes,dashes,dashes,dashes,dashes);
 
843
 
 
844
#ifdef INCREMENTAL
 
845
        {
 
846
            INC_Page *page = inc_used_mem;
 
847
            /* Genom att g� igenom fri-listan f�rst kan vi markera de
 
848
               omr�den som inte �r allokerade och bara skriva ut de som
 
849
               lever.
 
850
               char markarea[INC_PAGESIZE];
 
851
            */
 
852
 
 
853
            while (page) {
 
854
                Eterm *ptr = (Eterm*)page->start;
 
855
                Eterm *end = (Eterm*)page->start + INC_PAGESIZE;
 
856
 
 
857
                erts_printf("| %*s   | This: 0x%0*lx   Next: 0x%0*lx %*s|\n",
 
858
                            PTR_SIZE, "",
 
859
                            PTR_SIZE, (unsigned long)page,
 
860
                            PTR_SIZE, (unsigned long)page->next,
 
861
                            2 * PTR_SIZE - 8, "");
 
862
                print_untagged_memory(ptr,end);
 
863
                page = page->next;
 
864
            }
 
865
        }
 
866
 
 
867
        {
 
868
            INC_MemBlock *this = inc_free_list;
 
869
 
 
870
            erts_printf("-- %-*s --%s-%s-%s-%s-\n",PTR_SIZE+2,"Free list",
 
871
                        dashes,dashes,dashes,dashes);
 
872
            while (this) {
 
873
                erts_printf("Block @ 0x%0*lx sz: %8d prev: 0x%0*lx next: 0x%0*lx\n",
 
874
                            PTR_SIZE, (unsigned long)this,this->size,
 
875
                            PTR_SIZE, (unsigned long)this->prev,
 
876
                            PTR_SIZE, (unsigned long)this->next);
 
877
                this = this->next;
 
878
            }
 
879
            erts_printf("--%s---%s-%s-%s-%s--\n",
 
880
                        dashes,dashes,dashes,dashes,dashes);
 
881
        }
 
882
 
 
883
        if (inc_fromspc != NULL) {
 
884
            erts_printf("-- fromspace - 0x%0*lx 0x%0*lx "
 
885
                        "------------------------------\n",
 
886
                        PTR_SIZE, (unsigned long)inc_fromspc,
 
887
                        PTR_SIZE, (unsigned long)inc_fromend);
 
888
            print_untagged_memory(inc_fromspc,inc_fromend);
 
889
        }
 
890
#endif /* INCREMENTAL */
 
891
    }
 
892
#endif /* HYBRID */
 
893
}
 
894
 
 
895
void print_memory_info(Process *p)
 
896
{
 
897
    if (p != NULL) {
 
898
        erts_printf("======================================\n");
 
899
        erts_printf("|| Memory info for %-12T ||\n",p->id);
 
900
        erts_printf("======================================\n");
 
901
        erts_printf("+- local heap ----%s-%s-%s-%s-+\n",
 
902
                    dashes,dashes,dashes,dashes);
 
903
        erts_printf("| Young | 0x%0*lx - (0x%0*lx) - 0x%0*lx - 0x%0*lx |\n",
 
904
                    PTR_SIZE, (unsigned long)HEAP_START(p),
 
905
                    PTR_SIZE, (unsigned long)HIGH_WATER(p),
 
906
                    PTR_SIZE, (unsigned long)HEAP_TOP(p),
 
907
                    PTR_SIZE, (unsigned long)HEAP_END(p));
 
908
        if (OLD_HEAP(p) != NULL)
 
909
            erts_printf("| Old   | 0x%0*lx - 0x%0*lx - 0x%0*lx   %*s     |\n",
 
910
                        PTR_SIZE, (unsigned long)OLD_HEAP(p),
 
911
                        PTR_SIZE, (unsigned long)OLD_HTOP(p),
 
912
                        PTR_SIZE, (unsigned long)OLD_HEND(p),
 
913
                        PTR_SIZE, "");
 
914
    } else {
 
915
        erts_printf("=================\n");
 
916
        erts_printf("|| Memory info ||\n");
 
917
        erts_printf("=================\n");
 
918
    }
 
919
#ifdef HYBRID
 
920
    erts_printf("|- message area --%s-%s-%s-%s-|\n",
 
921
                dashes,dashes,dashes,dashes);
 
922
    erts_printf("| Young | 0x%0*lx - 0x%0*lx - 0x%0*lx   %*s     |\n",
 
923
                PTR_SIZE, (unsigned long)global_heap,
 
924
                PTR_SIZE, (unsigned long)global_htop,
 
925
                PTR_SIZE, (unsigned long)global_hend,
 
926
                PTR_SIZE, "");
 
927
    erts_printf("| Old   | 0x%0*lx - 0x%0*lx      %*s       |\n",
 
928
                PTR_SIZE, (unsigned long)global_old_heap,
 
929
                PTR_SIZE, (unsigned long)global_old_hend,
 
930
                2 * PTR_SIZE, "");
 
931
#endif
 
932
#ifdef INCREMENTAL
 
933
    if (inc_fromspc != NULL)
 
934
        erts_printf("| Frmsp | 0x%0*lx - 0x%0*lx      %*s  |\n",
 
935
                    PTR_SIZE, (unsigned long)inc_fromspc,
 
936
                    PTR_SIZE, (unsigned long)inc_fromend,
 
937
                    2 * PTR_SIZE, "");
 
938
#endif
 
939
    erts_printf("+-----------------%s-%s-%s-%s-+\n",dashes,dashes,dashes,dashes);
 
940
}
 
941
#endif
 
942