Ejemplo n.º 1
0
// Retainer scheme 1: retainer = info table
void
printRetainerSetShort(FILE *f, RetainerSet *rs)
{
#define MAX_RETAINER_SET_SPACE  24
    char tmp[MAX_RETAINER_SET_SPACE + 1];
    int size;
    nat j;

    ASSERT(rs->id < 0);

    tmp[MAX_RETAINER_SET_SPACE] = '\0';

    // No blank characters are allowed.
    sprintf(tmp + 0, "(%d)", -(rs->id));
    size = strlen(tmp);
    ASSERT(size < MAX_RETAINER_SET_SPACE);

    for (j = 0; j < rs->num; j++) {
	if (j < rs->num - 1) {
	    strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), MAX_RETAINER_SET_SPACE - size);
	    size = strlen(tmp);
	    if (size == MAX_RETAINER_SET_SPACE)
		break;
	    strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
	    size = strlen(tmp);
	    if (size == MAX_RETAINER_SET_SPACE)
		break;
	}
	else {
	    strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), MAX_RETAINER_SET_SPACE - size);
	    // size = strlen(tmp);
	}
    }
    fprintf(f, tmp);
}
Ejemplo n.º 2
0
/* ----------------------------------------------------------------------------
 * Find the "closure identity", which is a unique pointer representing
 * the band to which this closure's heap space is attributed in the
 * heap profile.
 * ------------------------------------------------------------------------- */
static void *
closureIdentity( StgClosure *p )
{
    switch (RtsFlags.ProfFlags.doHeapProfile) {

#ifdef PROFILING
    case HEAP_BY_CCS:
        return p->header.prof.ccs;
    case HEAP_BY_MOD:
        return p->header.prof.ccs->cc->module;
    case HEAP_BY_DESCR:
        return GET_PROF_DESC(get_itbl(p));
    case HEAP_BY_TYPE:
        return GET_PROF_TYPE(get_itbl(p));
    case HEAP_BY_RETAINER:
        // AFAIK, the only closures in the heap which might not have a
        // valid retainer set are DEAD_WEAK closures.
        if (isRetainerSetFieldValid(p))
            return retainerSetOf(p);
        else
            return NULL;

#else
    case HEAP_BY_CLOSURE_TYPE:
    {
        StgInfoTable *info;
        info = get_itbl(p);
        switch (info->type) {
        case CONSTR:
        case CONSTR_1_0:
        case CONSTR_0_1:
        case CONSTR_2_0:
        case CONSTR_1_1:
        case CONSTR_0_2:
        case CONSTR_STATIC:
        case CONSTR_NOCAF_STATIC:
            return GET_CON_DESC(itbl_to_con_itbl(info));
        default:
            return closure_type_names[info->type];
        }
    }

#endif
    default:
        barf("closureIdentity");
    }
}
Ejemplo n.º 3
0
void
printClosure( const StgClosure *obj )
{
    const StgInfoTable *info;

    obj = UNTAG_CONST_CLOSURE(obj);
    info = get_itbl(obj);

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

    case CONSTR:
    case CONSTR_1_0: case CONSTR_0_1:
    case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
    case CONSTR_STATIC:
    case CONSTR_NOCAF_STATIC:
        {
            StgWord i, j;
            const StgConInfoTable *con_info = get_con_itbl (obj);

            debugBelch("%s(", GET_CON_DESC(con_info));
            for (i = 0; i < info->layout.payload.ptrs; ++i) {
                if (i != 0) debugBelch(", ");
                printPtr((StgPtr)obj->payload[i]);
            }
            for (j = 0; j < info->layout.payload.nptrs; ++j) {
                if (i != 0 || j != 0) debugBelch(", ");
                debugBelch("%p#", obj->payload[i+j]);
            }
            debugBelch(")\n");
            break;
        }

    case FUN:
    case FUN_1_0: case FUN_0_1:
    case FUN_1_1: case FUN_0_2: case FUN_2_0:
    case FUN_STATIC:
        debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity);
        printPtr((StgPtr)obj->header.info);
#ifdef PROFILING
        debugBelch(", %s", obj->header.prof.ccs->cc->label);
#endif
        printStdObjPayload(obj);
        break;

    case PRIM:
        debugBelch("PRIM(");
        printPtr((StgPtr)obj->header.info);
        printStdObjPayload(obj);
        break;

    case MUT_PRIM:
        debugBelch("MUT_PRIM(");
        printPtr((StgPtr)obj->header.info);
        printStdObjPayload(obj);
        break;

    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? */
#ifdef PROFILING
            printThunkObject((StgThunk *)obj,GET_PROF_DESC(info));
#else
            printThunkObject((StgThunk *)obj,"THUNK");
#endif
            break;

    case THUNK_SELECTOR:
        printStdObjHdr(obj, "THUNK_SELECTOR");
        debugBelch(", %p)\n", ((StgSelector *)obj)->selectee);
        break;

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

    case AP:
        {
            StgAP* ap = (StgAP*)obj;
            StgWord i;
            debugBelch("AP("); printPtr((StgPtr)ap->fun);
            for (i = 0; i < ap->n_args; ++i) {
                debugBelch(", ");
                printPtr((P_)ap->payload[i]);
            }
            debugBelch(")\n");
            break;
        }

    case PAP:
        {
            StgPAP* pap = (StgPAP*)obj;
            StgWord i;
            debugBelch("PAP/%d(",(int)pap->arity);
            printPtr((StgPtr)pap->fun);
            for (i = 0; i < pap->n_args; ++i) {
                debugBelch(", ");
                printPtr((StgPtr)pap->payload[i]);
            }
            debugBelch(")\n");
            break;
        }

    case AP_STACK:
        {
            StgAP_STACK* ap = (StgAP_STACK*)obj;
            StgWord i;
            debugBelch("AP_STACK("); printPtr((StgPtr)ap->fun);
            for (i = 0; i < ap->size; ++i) {
                debugBelch(", ");
                printPtr((P_)ap->payload[i]);
            }
            debugBelch(")\n");
            break;
        }

    case IND:
            debugBelch("IND(");
            printPtr((StgPtr)((StgInd*)obj)->indirectee);
            debugBelch(")\n");
            break;

    case IND_STATIC:
            debugBelch("IND_STATIC(");
            printPtr((StgPtr)((StgInd*)obj)->indirectee);
            debugBelch(")\n");
            break;

    case BLACKHOLE:
            debugBelch("BLACKHOLE(");
            printPtr((StgPtr)((StgInd*)obj)->indirectee);
            debugBelch(")\n");
            break;

    /* Cannot happen -- use default case.
    case RET_BCO:
    case RET_SMALL:
    case RET_BIG:
    case RET_FUN:
    */

    case UPDATE_FRAME:
        {
            StgUpdateFrame* u = (StgUpdateFrame*)obj;
            debugBelch("%s(", info_update_frame(obj));
            printPtr((StgPtr)GET_INFO((StgClosure *)u));
            debugBelch(",");
            printPtr((StgPtr)u->updatee);
            debugBelch(")\n");
            break;
        }

    case CATCH_FRAME:
        {
            StgCatchFrame* u = (StgCatchFrame*)obj;
            debugBelch("CATCH_FRAME(");
            printPtr((StgPtr)GET_INFO((StgClosure *)u));
            debugBelch(",");
            printPtr((StgPtr)u->handler);
            debugBelch(")\n");
            break;
        }

    case UNDERFLOW_FRAME:
        {
            StgUnderflowFrame* u = (StgUnderflowFrame*)obj;
            debugBelch("UNDERFLOW_FRAME(");
            printPtr((StgPtr)u->next_chunk);
            debugBelch(")\n");
            break;
        }

    case STOP_FRAME:
        {
            StgStopFrame* u = (StgStopFrame*)obj;
            debugBelch("STOP_FRAME(");
            printPtr((StgPtr)GET_INFO((StgClosure *)u));
            debugBelch(")\n");
            break;
        }

    case ARR_WORDS:
        {
            StgWord i;
            debugBelch("ARR_WORDS(\"");
            for (i=0; i<arr_words_words((StgArrBytes *)obj); i++)
              debugBelch("%" FMT_Word, (W_)((StgArrBytes *)obj)->payload[i]);
            debugBelch("\")\n");
            break;
        }

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

    case MUT_ARR_PTRS_DIRTY:
        debugBelch("MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
        break;

    case MUT_ARR_PTRS_FROZEN:
        debugBelch("MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
        break;

    case SMALL_MUT_ARR_PTRS_CLEAN:
        debugBelch("SMALL_MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n",
                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
        break;

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

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

    case MVAR_CLEAN:
    case MVAR_DIRTY:
        {
          StgMVar* mv = (StgMVar*)obj;
          debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value);
          break;
        }

    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;
        }

    case MUT_VAR_CLEAN:
        {
          StgMutVar* mv = (StgMutVar*)obj;
          debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var);
          break;
        }

    case MUT_VAR_DIRTY:
        {
          StgMutVar* mv = (StgMutVar*)obj;
          debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var);
          break;
        }

    case WEAK:
            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' ? */
            break;

    case TSO:
      debugBelch("TSO(");
      debugBelch("%lu (%p)",(unsigned long)(((StgTSO*)obj)->id), (StgTSO*)obj);
      debugBelch(")\n");
      break;

    case STACK:
      debugBelch("STACK");
      break;

#if 0
      /* Symptomatic of a problem elsewhere, have it fall-through & fail */
    case EVACUATED:
      debugBelch("EVACUATED(");
      printClosure((StgEvacuated*)obj->evacuee);
      debugBelch(")\n");
      break;
#endif

    case COMPACT_NFDATA:
        debugBelch("COMPACT_NFDATA(size=%" FMT_Word ")\n",
                   (W_)((StgCompactNFData *)obj)->totalDataW * sizeof(W_));
        break;


    default:
            //barf("printClosure %d",get_itbl(obj)->type);
            debugBelch("*** printClosure: unknown type %d ****\n",
                    (int)get_itbl(obj)->type );
            barf("printClosure %d",get_itbl(obj)->type);
            return;
    }
}
Ejemplo n.º 4
0
// Retainer scheme 1: retainer = info table
void
printRetainer(FILE *f, retainer itbl)
{
    fprintf(f, "%s[%s]", GET_PROF_DESC(itbl), itbl->prof.closure_type);
}