Printer.c 26.5 KB
Newer Older
1
2
/* -----------------------------------------------------------------------------
 *
3
 * (c) The GHC Team, 1994-2000.
4
5
 *
 * Heap printer
6
 *
7
8
 * ---------------------------------------------------------------------------*/

9
#include "PosixSource.h"
10
11
#include "ghcconfig.h"

12
#include "Rts.h"
Simon Marlow's avatar
Simon Marlow committed
13
14
#include "rts/Bytecodes.h"  /* for InstrPtr */

15
#include "sm/Storage.h"
16
#include "Hash.h"
17
#include "Printer.h"
18
#include "RtsUtils.h"
19

Ben Gamari's avatar
Ben Gamari committed
20
#if defined(PROFILING)
21
22
23
#include "Profiling.h"
#endif

24
25
#include <string.h>

Ben Gamari's avatar
Ben Gamari committed
26
#if defined(DEBUG)
27
28

#include "Disassembler.h"
sof's avatar
sof committed
29
#include "Apply.h"
30
31
32
33
34

/* --------------------------------------------------------------------------
 * local function decls
 * ------------------------------------------------------------------------*/

35
static void    printStdObjPayload( const StgClosure *obj );
36
37
38
39
40

/* --------------------------------------------------------------------------
 * Printer
 * ------------------------------------------------------------------------*/

41
void printPtr( StgPtr p )
42
43
{
    const char *raw;
44
45
    raw = lookupGHCName(p);
    if (raw != NULL) {
46
47
        debugBelch("<%s>", raw);
        debugBelch("[%p]", p);
48
    } else {
49
        debugBelch("%p", p);
50
51
    }
}
52

53
54
void printObj( StgClosure *obj )
{
55
    debugBelch("Object "); printPtr((StgPtr)obj); debugBelch(" = ");
56
57
58
    printClosure(obj);
}

sof's avatar
sof committed
59
STATIC_INLINE void
60
printStdObjHdr( const StgClosure *obj, char* tag )
61
{
62
    debugBelch("%s(",tag);
63
    printPtr((StgPtr)obj->header.info);
Ben Gamari's avatar
Ben Gamari committed
64
#if defined(PROFILING)
65
    debugBelch(", %s", obj->header.prof.ccs->cc->label);
66
#endif
67
68
69
}

static void
70
printStdObjPayload( const StgClosure *obj )
71
72
73
74
75
{
    StgWord i, j;
    const StgInfoTable* info;

    info = get_itbl(obj);
76
    for (i = 0; i < info->layout.payload.ptrs; ++i) {
77
        debugBelch(", ");
78
        printPtr((StgPtr)obj->payload[i]);
79
80
    }
    for (j = 0; j < info->layout.payload.nptrs; ++j) {
81
        debugBelch(", %pd#",obj->payload[i+j]);
82
    }
83
    debugBelch(")\n");
84
85
}

86
87
88
89
90
91
static void
printThunkPayload( StgThunk *obj )
{
    StgWord i, j;
    const StgInfoTable* info;

92
    info = get_itbl((StgClosure *)obj);
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
    for (i = 0; i < info->layout.payload.ptrs; ++i) {
        debugBelch(", ");
        printPtr((StgPtr)obj->payload[i]);
    }
    for (j = 0; j < info->layout.payload.nptrs; ++j) {
        debugBelch(", %pd#",obj->payload[i+j]);
    }
    debugBelch(")\n");
}

static void
printThunkObject( StgThunk *obj, char* tag )
{
    printStdObjHdr( (StgClosure *)obj, tag );
    printThunkPayload( obj );
}

110
void
111
printClosure( const StgClosure *obj )
112
{
113
    const StgInfoTable *info;
114

115
    obj = UNTAG_CONST_CLOSURE(obj);
116
117
118
    info = get_itbl(obj);

    switch ( info->type ) {
119
120
    case INVALID_OBJECT:
            barf("Invalid object");
121

sof's avatar
sof committed
122
123
124
    case CONSTR:
    case CONSTR_1_0: case CONSTR_0_1:
    case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
Simon Marlow's avatar
Simon Marlow committed
125
    case CONSTR_NOCAF:
126
        {
sof's avatar
sof committed
127
            StgWord i, j;
128
            const StgConInfoTable *con_info = get_con_itbl (obj);
129

130
            debugBelch("%s(", GET_CON_DESC(con_info));
sof's avatar
sof committed
131
            for (i = 0; i < info->layout.payload.ptrs; ++i) {
132
                if (i != 0) debugBelch(", ");
sof's avatar
sof committed
133
134
135
                printPtr((StgPtr)obj->payload[i]);
            }
            for (j = 0; j < info->layout.payload.nptrs; ++j) {
136
                if (i != 0 || j != 0) debugBelch(", ");
137
                debugBelch("%p#", obj->payload[i+j]);
138
            }
139
            debugBelch(")\n");
140
141
142
            break;
        }

sof's avatar
sof committed
143
    case FUN:
144
    case FUN_1_0: case FUN_0_1:
sof's avatar
sof committed
145
146
    case FUN_1_1: case FUN_0_2: case FUN_2_0:
    case FUN_STATIC:
147
148
        debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity);
        printPtr((StgPtr)obj->header.info);
Ben Gamari's avatar
Ben Gamari committed
149
#if defined(PROFILING)
150
        debugBelch(", %s", obj->header.prof.ccs->cc->label);
sof's avatar
sof committed
151
#endif
152
153
        printStdObjPayload(obj);
        break;
sof's avatar
sof committed
154

155
    case PRIM:
156
157
158
159
        debugBelch("PRIM(");
        printPtr((StgPtr)obj->header.info);
        printStdObjPayload(obj);
        break;
160

161
162
    case MUT_PRIM:
        debugBelch("MUT_PRIM(");
163
164
165
        printPtr((StgPtr)obj->header.info);
        printStdObjPayload(obj);
        break;
166

sof's avatar
sof committed
167
168
169
170
171
    case THUNK:
    case THUNK_1_0: case THUNK_0_1:
    case THUNK_1_1: case THUNK_0_2: case THUNK_2_0:
    case THUNK_STATIC:
            /* ToDo: will this work for THUNK_STATIC too? */
Ben Gamari's avatar
Ben Gamari committed
172
#if defined(PROFILING)
Simon Marlow's avatar
Simon Marlow committed
173
            printThunkObject((StgThunk *)obj,GET_PROF_DESC(info));
sof's avatar
sof committed
174
#else
175
            printThunkObject((StgThunk *)obj,"THUNK");
sof's avatar
sof committed
176
177
178
179
#endif
            break;

    case THUNK_SELECTOR:
180
181
182
        printStdObjHdr(obj, "THUNK_SELECTOR");
        debugBelch(", %p)\n", ((StgSelector *)obj)->selectee);
        break;
sof's avatar
sof committed
183
184
185
186
187

    case BCO:
            disassemble( (StgBCO*)obj );
            break;

188
    case AP:
189
        {
190
            StgAP* ap = (StgAP*)obj;
191
            StgWord i;
192
            debugBelch("AP("); printPtr((StgPtr)ap->fun);
193
            for (i = 0; i < ap->n_args; ++i) {
194
                debugBelch(", ");
195
                printPtr((P_)ap->payload[i]);
196
            }
197
            debugBelch(")\n");
198
199
            break;
        }
200

201
202
    case PAP:
        {
203
            StgPAP* pap = (StgPAP*)obj;
204
            StgWord i;
205
206
            debugBelch("PAP/%d(",(int)pap->arity);
            printPtr((StgPtr)pap->fun);
207
            for (i = 0; i < pap->n_args; ++i) {
208
                debugBelch(", ");
209
                printPtr((StgPtr)pap->payload[i]);
210
            }
211
            debugBelch(")\n");
212
213
            break;
        }
214

sof's avatar
sof committed
215
216
    case AP_STACK:
        {
217
            StgAP_STACK* ap = (StgAP_STACK*)obj;
sof's avatar
sof committed
218
            StgWord i;
219
            debugBelch("AP_STACK("); printPtr((StgPtr)ap->fun);
sof's avatar
sof committed
220
            for (i = 0; i < ap->size; ++i) {
221
                debugBelch(", ");
sof's avatar
sof committed
222
223
                printPtr((P_)ap->payload[i]);
            }
224
            debugBelch(")\n");
225
            break;
sof's avatar
sof committed
226
        }
227

228
    case IND:
229
            debugBelch("IND(");
Simon Marlow's avatar
Simon Marlow committed
230
            printPtr((StgPtr)((StgInd*)obj)->indirectee);
231
            debugBelch(")\n");
232
233
            break;

234
    case IND_STATIC:
235
            debugBelch("IND_STATIC(");
Simon Marlow's avatar
Simon Marlow committed
236
            printPtr((StgPtr)((StgInd*)obj)->indirectee);
237
            debugBelch(")\n");
238
239
            break;

240
    case BLACKHOLE:
241
            debugBelch("BLACKHOLE(");
242
            printPtr((StgPtr)((StgInd*)obj)->indirectee);
243
            debugBelch(")\n");
244
245
            break;

sof's avatar
sof committed
246
247
248
249
250
251
252
253
254
    /* Cannot happen -- use default case.
    case RET_BCO:
    case RET_SMALL:
    case RET_BIG:
    case RET_FUN:
    */

    case UPDATE_FRAME:
        {
Simon Marlow's avatar
Simon Marlow committed
255
            StgUpdateFrame* u = (StgUpdateFrame*)obj;
256
            debugBelch("%s(", info_update_frame(obj));
257
            printPtr((StgPtr)GET_INFO((StgClosure *)u));
258
            debugBelch(",");
sof's avatar
sof committed
259
            printPtr((StgPtr)u->updatee);
260
            debugBelch(")\n");
261
            break;
sof's avatar
sof committed
262
263
264
265
        }

    case CATCH_FRAME:
        {
Simon Marlow's avatar
Simon Marlow committed
266
            StgCatchFrame* u = (StgCatchFrame*)obj;
267
            debugBelch("CATCH_FRAME(");
268
            printPtr((StgPtr)GET_INFO((StgClosure *)u));
269
            debugBelch(",");
sof's avatar
sof committed
270
            printPtr((StgPtr)u->handler);
271
            debugBelch(")\n");
sof's avatar
sof committed
272
273
274
            break;
        }

275
276
277
278
279
    case UNDERFLOW_FRAME:
        {
            StgUnderflowFrame* u = (StgUnderflowFrame*)obj;
            debugBelch("UNDERFLOW_FRAME(");
            printPtr((StgPtr)u->next_chunk);
280
            debugBelch(")\n");
281
282
283
            break;
        }

sof's avatar
sof committed
284
285
    case STOP_FRAME:
        {
Simon Marlow's avatar
Simon Marlow committed
286
            StgStopFrame* u = (StgStopFrame*)obj;
287
            debugBelch("STOP_FRAME(");
288
            printPtr((StgPtr)GET_INFO((StgClosure *)u));
289
            debugBelch(")\n");
sof's avatar
sof committed
290
291
            break;
        }
292

sof's avatar
sof committed
293
294
295
    case ARR_WORDS:
        {
            StgWord i;
296
            debugBelch("ARR_WORDS(\"");
siddhanathan's avatar
siddhanathan committed
297
298
            for (i=0; i<arr_words_words((StgArrBytes *)obj); i++)
              debugBelch("%" FMT_Word, (W_)((StgArrBytes *)obj)->payload[i]);
299
            debugBelch("\")\n");
300
            break;
sof's avatar
sof committed
301
        }
302

303
    case MUT_ARR_PTRS_CLEAN:
304
305
        debugBelch("MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
        break;
306
307

    case MUT_ARR_PTRS_DIRTY:
308
309
        debugBelch("MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
        break;
sof's avatar
sof committed
310
311

    case MUT_ARR_PTRS_FROZEN:
312
313
        debugBelch("MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
        break;
sof's avatar
sof committed
314

315
    case SMALL_MUT_ARR_PTRS_CLEAN:
316
        debugBelch("SMALL_MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n",
317
                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
318
        break;
319
320

    case SMALL_MUT_ARR_PTRS_DIRTY:
321
        debugBelch("SMALL_MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n",
322
                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
323
        break;
324
325

    case SMALL_MUT_ARR_PTRS_FROZEN:
326
        debugBelch("SMALL_MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n",
327
                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
328
        break;
329

330
331
    case MVAR_CLEAN:
    case MVAR_DIRTY:
sof's avatar
sof committed
332
        {
333
334
          StgMVar* mv = (StgMVar*)obj;
          debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value);
sof's avatar
sof committed
335
336
337
          break;
        }

338
339
340
341
342
343
344
    case TVAR:
        {
          StgTVar* tv = (StgTVar*)obj;
          debugBelch("TVAR(value=%p, wq=%p, num_updates=%" FMT_Word ")\n", tv->current_value, tv->first_watch_queue_entry, tv->num_updates);
          break;
        }

345
    case MUT_VAR_CLEAN:
sof's avatar
sof committed
346
        {
347
348
          StgMutVar* mv = (StgMutVar*)obj;
          debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var);
349
350
351
352
353
          break;
        }

    case MUT_VAR_DIRTY:
        {
354
355
          StgMutVar* mv = (StgMutVar*)obj;
          debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var);
sof's avatar
sof committed
356
357
358
359
          break;
        }

    case WEAK:
360
361
362
363
364
365
366
            debugBelch("WEAK(");
            debugBelch(" key=%p value=%p finalizer=%p",
                    (StgPtr)(((StgWeak*)obj)->key),
                    (StgPtr)(((StgWeak*)obj)->value),
                    (StgPtr)(((StgWeak*)obj)->finalizer));
            debugBelch(")\n");
            /* ToDo: chase 'link' ? */
sof's avatar
sof committed
367
368
            break;

369
    case TSO:
370
      debugBelch("TSO(");
371
      debugBelch("%lu (%p)",(unsigned long)(((StgTSO*)obj)->id), (StgTSO*)obj);
372
      debugBelch(")\n");
373
374
      break;

375
376
377
378
    case STACK:
      debugBelch("STACK");
      break;

sof's avatar
sof committed
379
380
381
#if 0
      /* Symptomatic of a problem elsewhere, have it fall-through & fail */
    case EVACUATED:
382
      debugBelch("EVACUATED(");
sof's avatar
sof committed
383
      printClosure((StgEvacuated*)obj->evacuee);
384
      debugBelch(")\n");
sof's avatar
sof committed
385
      break;
386
#endif
387

gcampax's avatar
gcampax committed
388
389
    case COMPACT_NFDATA:
        debugBelch("COMPACT_NFDATA(size=%" FMT_Word ")\n",
390
                   (W_)((StgCompactNFData *)obj)->totalW * sizeof(W_));
gcampax's avatar
gcampax committed
391
392
393
        break;


394
    default:
395
            //barf("printClosure %d",get_itbl(obj)->type);
396
            debugBelch("*** printClosure: unknown type %d ****\n",
Ian Lynagh's avatar
Ian Lynagh committed
397
                    (int)get_itbl(obj)->type );
398
            barf("printClosure %d",get_itbl(obj)->type);
399
400
401
402
            return;
    }
}

403
// If you know you have an UPDATE_FRAME, but want to know exactly which.
404
405
const char *info_update_frame(const StgClosure *closure)
{
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
    // Note: We intentionally don't take the info table pointer as
    // an argument. As it will be confusing whether one should pass
    // it pointing to the code or struct members when compiling with
    // TABLES_NEXT_TO_CODE.
    const StgInfoTable *info = closure->header.info;
    if (info == &stg_upd_frame_info) {
        return "NORMAL_UPDATE_FRAME";
    } else if (info == &stg_bh_upd_frame_info) {
        return "BH_UPDATE_FRAME";
    } else if (info == &stg_marked_upd_frame_info) {
        return "MARKED_UPDATE_FRAME";
    } else {
        return "ERROR: Not an update frame!!!";
    }
}

422
423
424
425
426
427
428
/*
void printGraph( StgClosure *obj )
{
 printClosure(obj);
}
*/

429
static void
430
431
printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap,
                    uint32_t size )
432
{
433
    uint32_t i;
434
435

    for(i = 0; i < size; i++, bitmap >>= 1 ) {
436
437
438
439
440
441
442
        debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i);
        if ((bitmap & 1) == 0) {
            printPtr((P_)payload[i]);
            debugBelch("\n");
        } else {
            debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
        }
443
444
445
446
    }
}

static void
447
448
printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap,
                    uint32_t size )
449
450
{
    StgWord bmp;
451
    uint32_t i, j;
452
453
454

    i = 0;
    for (bmp=0; i < size; bmp++) {
455
456
457
458
459
460
461
462
463
464
465
        StgWord bitmap = large_bitmap->bitmap[bmp];
        j = 0;
        for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
            debugBelch("   stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i);
            if ((bitmap & 1) == 0) {
                printPtr((P_)payload[i]);
                debugBelch("\n");
            } else {
                debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
            }
        }
466
467
468
469
470
    }
}

void
printStackChunk( StgPtr sp, StgPtr spBottom )
471
{
ken's avatar
ken committed
472
    StgWord bitmap;
473
474
475
    const StgInfoTable *info;

    ASSERT(sp <= spBottom);
476
477
    for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {

478
479
480
        info = get_itbl((StgClosure *)sp);

        switch (info->type) {
481

482
483
        case UPDATE_FRAME:
        case CATCH_FRAME:
484
485
        case UNDERFLOW_FRAME:
        case STOP_FRAME:
486
            printClosure((StgClosure*)sp);
487
            continue;
488

489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
        case RET_SMALL: {
            StgWord c = *sp;
            if (c == (StgWord)&stg_ctoi_R1p_info) {
                debugBelch("tstg_ctoi_ret_R1p_info\n" );
            } else if (c == (StgWord)&stg_ctoi_R1n_info) {
                debugBelch("stg_ctoi_ret_R1n_info\n" );
            } else if (c == (StgWord)&stg_ctoi_F1_info) {
                debugBelch("stg_ctoi_ret_F1_info\n" );
            } else if (c == (StgWord)&stg_ctoi_D1_info) {
                debugBelch("stg_ctoi_ret_D1_info\n" );
            } else if (c == (StgWord)&stg_ctoi_V_info) {
                debugBelch("stg_ctoi_ret_V_info\n" );
            } else if (c == (StgWord)&stg_ap_v_info) {
                debugBelch("stg_ap_v_info\n" );
            } else if (c == (StgWord)&stg_ap_f_info) {
                debugBelch("stg_ap_f_info\n" );
            } else if (c == (StgWord)&stg_ap_d_info) {
                debugBelch("stg_ap_d_info\n" );
            } else if (c == (StgWord)&stg_ap_l_info) {
                debugBelch("stg_ap_l_info\n" );
            } else if (c == (StgWord)&stg_ap_n_info) {
                debugBelch("stg_ap_n_info\n" );
            } else if (c == (StgWord)&stg_ap_p_info) {
                debugBelch("stg_ap_p_info\n" );
            } else if (c == (StgWord)&stg_ap_pp_info) {
                debugBelch("stg_ap_pp_info\n" );
            } else if (c == (StgWord)&stg_ap_ppp_info) {
                debugBelch("stg_ap_ppp_info\n" );
            } else if (c == (StgWord)&stg_ap_pppp_info) {
                debugBelch("stg_ap_pppp_info\n" );
            } else if (c == (StgWord)&stg_ap_ppppp_info) {
                debugBelch("stg_ap_ppppp_info\n" );
            } else if (c == (StgWord)&stg_ap_pppppp_info) {
                debugBelch("stg_ap_pppppp_info\n" );
Ben Gamari's avatar
Ben Gamari committed
523
#if defined(PROFILING)
524
525
526
527
528
            } else if (c == (StgWord)&stg_restore_cccs_info) {
                debugBelch("stg_restore_cccs_info\n" );
                fprintCCS(stderr, (CostCentreStack*)sp[1]);
                debugBelch("\n" );
                continue;
Simon Marlow's avatar
Simon Marlow committed
529
530
531
532
533
            } else if (c == (StgWord)&stg_restore_cccs_eval_info) {
                debugBelch("stg_restore_cccs_eval_info\n" );
                fprintCCS(stderr, (CostCentreStack*)sp[1]);
                debugBelch("\n" );
                continue;
534
535
536
537
#endif
            } else {
                debugBelch("RET_SMALL (%p)\n", info);
            }
538
539
540
541
            bitmap = info->layout.bitmap;
            printSmallBitmap(spBottom, sp+1,
                             BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
            continue;
542
        }
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559

        case RET_BCO: {
            StgBCO *bco;

            bco = ((StgBCO *)sp[1]);

            debugBelch("RET_BCO (%p)\n", sp);
            printLargeBitmap(spBottom, sp+2,
                             BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
            continue;
        }

        case RET_BIG:
            barf("todo");

        case RET_FUN:
        {
560
            const StgFunInfoTable *fun_info;
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
            StgRetFun *ret_fun;

            ret_fun = (StgRetFun *)sp;
            fun_info = get_fun_itbl(ret_fun->fun);
            debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type);
            switch (fun_info->f.fun_type) {
            case ARG_GEN:
                printSmallBitmap(spBottom, sp+2,
                                 BITMAP_BITS(fun_info->f.b.bitmap),
                                 BITMAP_SIZE(fun_info->f.b.bitmap));
                break;
            case ARG_GEN_BIG:
                printLargeBitmap(spBottom, sp+2,
                                 GET_FUN_LARGE_BITMAP(fun_info),
                                 GET_FUN_LARGE_BITMAP(fun_info)->size);
                break;
            default:
                printSmallBitmap(spBottom, sp+2,
                                 BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
                                 BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
                break;
            }
            continue;
        }

        default:
            debugBelch("unknown object %d\n", (int)info->type);
            barf("printStackChunk");
        }
590
591
592
593
594
    }
}

void printTSO( StgTSO *tso )
{
595
596
    printStackChunk( tso->stackobj->sp,
                     tso->stackobj->stack+tso->stackobj->stack_size);
597
598
599
600
601
602
603
604
605
606
}

/* --------------------------------------------------------------------------
 * Address printing code
 *
 * Uses symbol table in (unstripped executable)
 * ------------------------------------------------------------------------*/

/* --------------------------------------------------------------------------
 * Simple lookup table
607
 * address -> function name
608
609
 * ------------------------------------------------------------------------*/

610
static HashTable * add_to_fname_table = NULL;
611

612
const char *lookupGHCName( void *addr )
613
{
614
    if (add_to_fname_table == NULL)
615
        return NULL;
616
617

    return lookupHashTable(add_to_fname_table, (StgWord)addr);
618
619
620
621
622
623
}

/* --------------------------------------------------------------------------
 * Symbol table loading
 * ------------------------------------------------------------------------*/

sof's avatar
sof committed
624
/* Causing linking trouble on Win32 plats, so I'm
625
   disabling this for now.
sof's avatar
sof committed
626
*/
Ben Gamari's avatar
Ben Gamari committed
627
#if defined(USING_LIBBFD)
628
629
630
631
632
633
634
635
636
637
#    define PACKAGE 1
#    define PACKAGE_VERSION 1
/* Those PACKAGE_* defines are workarounds for bfd:
 *     https://sourceware.org/bugzilla/show_bug.cgi?id=14243
 * ghc's build system filter PACKAGE_* values out specifically to avoid clashes
 * with user's autoconf-based Cabal packages.
 * It's a shame <bfd.h> checks for unrelated fields instead of actually used
 * macros.
 */
#    include <bfd.h>
638
639
640
641
642

/* Fairly ad-hoc piece of code that seems to filter out a lot of
 * rubbish like the obj-splitting symbols
 */

Ben Gamari's avatar
Ben Gamari committed
643
static bool isReal( flagword flags STG_UNUSED, const char *name )
644
645
646
{
#if 0
    /* ToDo: make this work on BFD */
647
    int tp = type & N_TYPE;
648
649
650
    if (tp == N_TEXT || tp == N_DATA) {
        return (name[0] == '_' && name[1] != '_');
    } else {
Ben Gamari's avatar
Ben Gamari committed
651
        return false;
652
653
    }
#else
654
655
656
    if (*name == '\0'  ||
        (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
        (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
Ben Gamari's avatar
Ben Gamari committed
657
        return false;
658
    }
Ben Gamari's avatar
Ben Gamari committed
659
    return true;
660
661
662
#endif
}

663
extern void DEBUG_LoadSymbols( const char *name )
664
665
666
667
668
669
670
{
    bfd* abfd;
    char **matching;

    bfd_init();
    abfd = bfd_openr(name, "default");
    if (abfd == NULL) {
671
        barf("can't open executable %s to get symbol table", name);
672
673
    }
    if (!bfd_check_format_matches (abfd, bfd_object, &matching)) {
674
        barf("mismatch");
675
676
677
    }

    {
678
679
680
        long storage_needed;
        asymbol **symbol_table;
        long number_of_symbols;
681
        long num_real_syms = 0;
682
683
684
685
686
687
688
689
        long i;

        storage_needed = bfd_get_symtab_upper_bound (abfd);

        if (storage_needed < 0) {
            barf("can't read symbol table");
        }
        symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
690

691
692
693
694
695
        number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table);

        if (number_of_symbols < 0) {
            barf("can't canonicalise symbol table");
        }
696

697
698
699
        if (add_to_fname_table == NULL)
            add_to_fname_table = allocHashTable();

700
701
702
703
        for( i = 0; i != number_of_symbols; ++i ) {
            symbol_info info;
            bfd_get_symbol_info(abfd,symbol_table[i],&info);
            if (isReal(info.type, info.name)) {
704
705
                insertHashTable(add_to_fname_table,
                                info.value, (void*)info.name);
706
707
708
                num_real_syms += 1;
            }
        }
709

710
        IF_DEBUG(interpreter,
711
                 debugBelch("Loaded %ld symbols. Of which %ld are real symbols\n",
712
713
714
                         number_of_symbols, num_real_syms)
                 );

sof's avatar
sof committed
715
        stgFree(symbol_table);
716
717
718
    }
}

719
#else /* USING_LIBBFD */
720

721
extern void DEBUG_LoadSymbols( const char *name STG_UNUSED )
722
{
rrt's avatar
rrt committed
723
  /* nothing, yet */
724
725
}

726
#endif /* USING_LIBBFD */
727

728
void findPtr(P_ p, int);                /* keep gcc -Wall happy */
729

730
731
732
733
734
int searched = 0;

static int
findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i)
{
735
    StgPtr q, r, end;
736
737
738
    for (; bd; bd = bd->link) {
        searched++;
        for (q = bd->start; q < bd->free; q++) {
739
            if (UNTAG_CONST_CLOSURE((StgClosure*)*q) == (const StgClosure *)p) {
740
                if (i < arr_size) {
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
                    for (r = bd->start; r < bd->free; r = end) {
                        // skip over zeroed-out slop
                        while (*r == 0) r++;
                        if (!LOOKS_LIKE_CLOSURE_PTR(r)) {
                            debugBelch("%p found at %p, no closure at %p\n",
                                       p, q, r);
                            break;
                        }
                        end = r + closure_sizeW((StgClosure*)r);
                        if (q < end) {
                            debugBelch("%p = ", r);
                            printClosure((StgClosure *)r);
                            arr[i++] = r;
                            break;
                        }
                    }
                    if (r >= bd->free) {
                        debugBelch("%p found at %p, closure?", p, q);
759
760
761
762
763
764
765
766
767
768
                    }
                } else {
                    return i;
                }
            }
        }
    }
    return i;
}

769
void
770
findPtr(P_ p, int follow)
771
{
772
  uint32_t g, n;
773
  bdescr *bd;
774
775
776
  const int arr_size = 1024;
  StgPtr arr[arr_size];
  int i = 0;
777
  searched = 0;
778

779
780
781
782
783
784
  for (n = 0; n < n_capabilities; n++) {
      bd = nurseries[i].blocks;
      i = findPtrBlocks(p,bd,arr,arr_size,i);
      if (i >= arr_size) return;
  }

785
  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
Simon Marlow's avatar
Simon Marlow committed
786
787
788
789
790
      bd = generations[g].blocks;
      i = findPtrBlocks(p,bd,arr,arr_size,i);
      bd = generations[g].large_objects;
      i = findPtrBlocks(p,bd,arr,arr_size,i);
      if (i >= arr_size) return;
791
792
  }
  if (follow && i == 1) {
793
      debugBelch("-->\n");
794
      findPtr(arr[0], 1);
795
796
797
  }
}

798
const char *what_next_strs[] = {
799
800
801
802
803
804
805
  [0]               = "(unknown)",
  [ThreadRunGHC]    = "ThreadRunGHC",
  [ThreadInterpret] = "ThreadInterpret",
  [ThreadKilled]    = "ThreadKilled",
  [ThreadComplete]  = "ThreadComplete"
};

806
807
808
#else /* DEBUG */
void printPtr( StgPtr p )
{
809
    debugBelch("ptr 0x%p (enable -DDEBUG for more info) " , p );
810
}
811

812
813
void printObj( StgClosure *obj )
{
814
    debugBelch("obj 0x%p (enable -DDEBUG for more info) " , obj );
815
}
816
817


818
#endif /* DEBUG */
819
820
821

/* -----------------------------------------------------------------------------
   Closure types
822

823
824
   NOTE: must be kept in sync with the closure types in
   includes/rts/storage/ClosureTypes.h
825
826
   -------------------------------------------------------------------------- */

827
const char *closure_type_names[] = {
828
829
830
831
832
833
834
 [INVALID_OBJECT]        = "INVALID_OBJECT",
 [CONSTR]                = "CONSTR",
 [CONSTR_1_0]            = "CONSTR_1_0",
 [CONSTR_0_1]            = "CONSTR_0_1",
 [CONSTR_2_0]            = "CONSTR_2_0",
 [CONSTR_1_1]            = "CONSTR_1_1",
 [CONSTR_0_2]            = "CONSTR_0_2",
Simon Marlow's avatar
Simon Marlow committed
835
 [CONSTR_NOCAF]          = "CONSTR_NOCAF",
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
 [FUN]                   = "FUN",
 [FUN_1_0]               = "FUN_1_0",
 [FUN_0_1]               = "FUN_0_1",
 [FUN_2_0]               = "FUN_2_0",
 [FUN_1_1]               = "FUN_1_1",
 [FUN_0_2]               = "FUN_0_2",
 [FUN_STATIC]            = "FUN_STATIC",
 [THUNK]                 = "THUNK",
 [THUNK_1_0]             = "THUNK_1_0",
 [THUNK_0_1]             = "THUNK_0_1",
 [THUNK_2_0]             = "THUNK_2_0",
 [THUNK_1_1]             = "THUNK_1_1",
 [THUNK_0_2]             = "THUNK_0_2",
 [THUNK_STATIC]          = "THUNK_STATIC",
 [THUNK_SELECTOR]        = "THUNK_SELECTOR",
 [BCO]                   = "BCO",
 [AP]                    = "AP",
 [PAP]                   = "PAP",
 [AP_STACK]              = "AP_STACK",
 [IND]                   = "IND",
 [IND_STATIC]            = "IND_STATIC",
 [RET_BCO]               = "RET_BCO",
 [RET_SMALL]             = "RET_SMALL",
 [RET_BIG]               = "RET_BIG",
 [RET_FUN]               = "RET_FUN",
 [UPDATE_FRAME]          = "UPDATE_FRAME",
 [CATCH_FRAME]           = "CATCH_FRAME",
863
 [UNDERFLOW_FRAME]       = "UNDERFLOW_FRAME",
864
 [STOP_FRAME]            = "STOP_FRAME",
865
 [BLOCKING_QUEUE]        = "BLOCKING_QUEUE",
866
 [BLACKHOLE]             = "BLACKHOLE",
867
868
 [MVAR_CLEAN]            = "MVAR_CLEAN",
 [MVAR_DIRTY]            = "MVAR_DIRTY",
869
 [TVAR]                  = "TVAR",
870
871
872
873
874
875
876
877
 [ARR_WORDS]             = "ARR_WORDS",
 [MUT_ARR_PTRS_CLEAN]    = "MUT_ARR_PTRS_CLEAN",
 [MUT_ARR_PTRS_DIRTY]    = "MUT_ARR_PTRS_DIRTY",
 [MUT_ARR_PTRS_FROZEN0]  = "MUT_ARR_PTRS_FROZEN0",
 [MUT_ARR_PTRS_FROZEN]   = "MUT_ARR_PTRS_FROZEN",
 [MUT_VAR_CLEAN]         = "MUT_VAR_CLEAN",
 [MUT_VAR_DIRTY]         = "MUT_VAR_DIRTY",
 [WEAK]                  = "WEAK",
878
 [PRIM]                  = "PRIM",
879
 [MUT_PRIM]              = "MUT_PRIM",
880
 [TSO]                   = "TSO",
881
 [STACK]                 = "STACK",
882
883
884
885
 [TREC_CHUNK]            = "TREC_CHUNK",
 [ATOMICALLY_FRAME]      = "ATOMICALLY_FRAME",
 [CATCH_RETRY_FRAME]     = "CATCH_RETRY_FRAME",
 [CATCH_STM_FRAME]       = "CATCH_STM_FRAME",
gcampax's avatar
gcampax committed
886
 [WHITEHOLE]             = "WHITEHOLE",
887
888
889
890
 [SMALL_MUT_ARR_PTRS_CLEAN] = "SMALL_MUT_ARR_PTRS_CLEAN",
 [SMALL_MUT_ARR_PTRS_DIRTY] = "SMALL_MUT_ARR_PTRS_DIRTY",
 [SMALL_MUT_ARR_PTRS_FROZEN0] = "SMALL_MUT_ARR_PTRS_FROZEN0",
 [SMALL_MUT_ARR_PTRS_FROZEN] = "SMALL_MUT_ARR_PTRS_FROZEN",
gcampax's avatar
gcampax committed
891
 [COMPACT_NFDATA]        = "COMPACT_NFDATA"
892
893
};

894
895
896
897
#if N_CLOSURE_TYPES != 64
#error Closure types changed: update Printer.c!
#endif

898
899
const char *
info_type(const StgClosure *closure){
900
901
902
  return closure_type_names[get_itbl(closure)->type];
}

903
904
const char *
info_type_by_ip(const StgInfoTable *ip){
905
906
907
908
  return closure_type_names[ip->type];
}

void
909
info_hdr_type(const StgClosure *closure, char *res){
910
911
  strcpy(res,closure_type_names[get_itbl(closure)->type]);
}