/*
- Time-stamp: <Fri Jan 14 2000 13:52:00 Stardate: [-30]4202.88 hwloidl>
+ Time-stamp: <Sun Mar 18 2001 19:32:56 Stardate: [-30]6349.07 hwloidl>
-Various debugging routines for GranSim and GUM
+ Various debugging routines for GranSim and GUM
*/
-#if defined(GRAN) || defined(PAR) /* whole file */
+#if defined(DEBUG) && (defined(GRAN) || defined(PAR)) /* whole file */
//@node Debugging routines for GranSim and GUM, , ,
//@section Debugging routines for GranSim and GUM
#include "GranSimRts.h"
#include "ParallelRts.h"
#include "StgMiscClosures.h"
+#include "Printer.h"
# if defined(DEBUG)
+# include "Hash.h"
+# include "Storage.h"
# include "ParallelDebug.h"
# endif
//@node Constants and Variables, Closures, Prototypes, Debugging routines for GranSim and GUM
//@subsection Constants and Variables
-/* Names as strings; needed by get_closure_info in ClosureMacros.h -- HWL */
-static char *closure_type_names[] = {
- "INVALID_OBJECT", /* 0 */
- "CONSTR", /* 1 */
- "CONSTR_1_0", /* 2 */
- "CONSTR_0_1", /* 3 */
- "CONSTR_2_0", /* 4 */
- "CONSTR_1_1", /* 5 */
- "CONSTR_0_2", /* 6 */
- "CONSTR_INTLIKE", /* 7 */
- "CONSTR_CHARLIKE", /* 8 */
- "CONSTR_STATIC", /* 9 */
- "CONSTR_NOCAF_STATIC", /* 10 */
- "FUN", /* 11 */
- "FUN_1_0", /* 12 */
- "FUN_0_1", /* 13 */
- "FUN_2_0", /* 14 */
- "FUN_1_1", /* 15 */
- "FUN_0_2", /* 16 */
- "FUN_STATIC", /* 17 */
- "THUNK", /* 18 */
- "THUNK_1_0", /* 19 */
- "THUNK_0_1", /* 20 */
- "THUNK_2_0", /* 21 */
- "THUNK_1_1", /* 22 */
- "THUNK_0_2", /* 23 */
- "THUNK_STATIC", /* 24 */
- "THUNK_SELECTOR", /* 25 */
- "BCO", /* 26 */
- "AP_UPD", /* 27 */
- "PAP", /* 28 */
- "IND", /* 29 */
- "IND_OLDGEN", /* 30 */
- "IND_PERM", /* 31 */
- "IND_OLDGEN_PERM", /* 32 */
- "IND_STATIC", /* 33 */
- "CAF_UNENTERED", /* 34 */
- "CAF_ENTERED", /* 35 */
- "CAF_BLACKHOLE", /* 36 */
- "RET_BCO", /* 37 */
- "RET_SMALL", /* 38 */
- "RET_VEC_SMALL", /* 39 */
- "RET_BIG", /* 40 */
- "RET_VEC_BIG", /* 41 */
- "RET_DYN", /* 42 */
- "UPDATE_FRAME", /* 43 */
- "CATCH_FRAME", /* 44 */
- "STOP_FRAME", /* 45 */
- "SEQ_FRAME", /* 46 */
- "BLACKHOLE", /* 47 */
- "BLACKHOLE_BQ", /* 48 */
- "SE_BLACKHOLE", /* 49 */
- "SE_CAF_BLACKHOLE", /* 50 */
- "MVAR", /* 51 */
- "ARR_WORDS", /* 52 */
- "MUT_ARR_PTRS", /* 53 */
- "MUT_ARR_PTRS_FROZEN", /* 54 */
- "MUT_VAR", /* 55 */
- "WEAK", /* 56 */
- "FOREIGN", /* 57 */
- "STABLE_NAME", /* 58 */
- "TSO", /* 59 */
- "BLOCKED_FETCH", /* 60 */
- "FETCH_ME", /* 61 */
- "EVACUATED", /* 62 */
- "N_CLOSURE_TYPES", /* 63 */
- "FETCH_ME_BQ", /* 64 */
- "RBH" /* 65 */
-};
+static HashTable *tmpClosureTable; // used in GraphFingerPrint and PrintGraph
+#if defined(PAR)
+static char finger_print_char[] = {
+ '/', /* INVALID_OBJECT 0 */
+ 'C', /* CONSTR 1 */
+ 'C', /* CONSTR_1_0 2 */
+ 'C', /* CONSTR_0_1 3 */
+ 'C', /* CONSTR_2_0 4 */
+ 'C', /* CONSTR_1_1 5 */
+ 'C', /* CONSTR_0_2 6 */
+ 'I', /* CONSTR_INTLIKE 7 */
+ 'I', /* CONSTR_CHARLIKE 8 */
+ 'S', /* CONSTR_STATIC 9 */
+ 'S', /* CONSTR_NOCAF_STATIC 10 */
+ 'F', /* FUN 11 */
+ 'F', /* FUN_1_0 12 */
+ 'F', /* FUN_0_1 13 */
+ 'F', /* FUN_2_0 14 */
+ 'F', /* FUN_1_1 15 */
+ 'F', /* FUN_0_2 16 */
+ 'S', /* FUN_STATIC 17 */
+ 'T', /* THUNK 18 */
+ 'T', /* THUNK_1_0 19 */
+ 'T', /* THUNK_0_1 20 */
+ 'T', /* THUNK_2_0 21 */
+ 'T', /* THUNK_1_1 22 */
+ 'T', /* THUNK_0_2 23 */
+ 'S', /* THUNK_STATIC 24 */
+ 'E', /* THUNK_SELECTOR 25 */
+ 'b', /* BCO 26 */
+ 'p', /* AP_UPD 27 */
+ 'p', /* PAP 28 */
+ '_', /* IND 29 */
+ '_', /* IND_OLDGEN 30 */
+ '_', /* IND_PERM 31 */
+ '_', /* IND_OLDGEN_PERM 32 */
+ '_', /* IND_STATIC 33 */
+ '?', /* ***unused*** 34 */
+ '?', /* ***unused*** 35 */
+ '^', /* RET_BCO 36 */
+ '^', /* RET_SMALL 37 */
+ '^', /* RET_VEC_SMALL 38 */
+ '^', /* RET_BIG 39 */
+ '^', /* RET_VEC_BIG 40 */
+ '^', /* RET_DYN 41 */
+ '~', /* UPDATE_FRAME 42 */
+ '~', /* CATCH_FRAME 43 */
+ '~', /* STOP_FRAME 44 */
+ '~', /* SEQ_FRAME 45 */
+ 'o', /* CAF_BLACKHOLE 46 */
+ 'o', /* BLACKHOLE 47 */
+ 'o', /* BLACKHOLE_BQ 48 */
+ 'o', /* SE_BLACKHOLE 49 */
+ 'o', /* SE_CAF_BLACKHOLE 50 */
+ 'm', /* MVAR 51 */
+ 'a', /* ARR_WORDS 52 */
+ 'a', /* MUT_ARR_PTRS 53 */
+ 'a', /* MUT_ARR_PTRS_FROZEN 54 */
+ 'q', /* MUT_VAR 55 */
+ 'w', /* WEAK 56 */
+ 'f', /* FOREIGN 57 */
+ 's', /* STABLE_NAME 58 */
+ '@', /* TSO 59 */
+ '#', /* BLOCKED_FETCH 60 */
+ '>', /* FETCH_ME 61 */
+ '>', /* FETCH_ME_BQ 62 */
+ '$', /* RBH 63 */
+ 'v', /* EVACUATED 64 */
+ '>' /* REMOTE_REF 65 */
+ /* ASSERT(there are N_CLOSURE_TYPES (==66) in this arrary) */
+};
+#endif /* PAR */
#if defined(GRAN) && defined(GRAN_CHECK)
//@node Closures, Threads, Constants and Variables, Debugging routines for GranSim and GUM
} else {
/* Fixed header */
fprintf(stderr, "(%s) FH [%#lx", info_type, node[locn++]);
- for (i = 1; i < FIXED_HS; i++)
+ for (i = 1; i < _HS; i++)
fprintf(stderr, " %#lx", node[locn++]);
/* Variable header */
#endif
#if defined(USE_COST_CENTRES)
- fprintf(stderr,"Cost Centre (???): 0x%lx\n",INFO_CAT(info_ptr));
+ fprintf(stderr,"Cost Centre (?): 0x%lx\n",INFO_CAT(info_ptr));
#endif
#if defined(_INFO_COPYING)
fprintf(stderr,"> Id: \t%#lx",closure->id);
// fprintf(stderr,"\tstate: \t%#lx",closure->state);
- fprintf(stderr,"\twhatNext: \t%#lx",closure->whatNext);
+ fprintf(stderr,"\twhat_next: \t%#lx",closure->what_next);
fprintf(stderr,"\tlink: \t%#lx\n",closure->link);
+ fprintf(stderr,"\twhy_blocked: \t%d", closure->why_blocked);
+ fprintf(stderr,"\tblock_info: \t%p\n", closure->block_info);
// fprintf(stderr,"\tType: \t%s\n",type_name[TSO_TYPE(closure)]);
fprintf(stderr,">PRI: \t%#lx", closure->gran.pri);
fprintf(stderr,"\tMAGIC: \t%#lx %s\n", closure->gran.magic,
fprintf(stderr,"\n ");
if(i < ptrs)
- fprintf(stderr," 0x%lx[P]",*(node+_FHS+vhs+i));
+ fprintf(stderr," 0x%lx[P]",*(node+_HS+vhs+i));
else
- fprintf(stderr," %lu[D]",*(node+_FHS+vhs+i));
+ fprintf(stderr," %lu[D]",*(node+_HS+vhs+i));
}
fprintf(stderr, "\n");
}
INFO_PTR(node) |= INFO_MASK;
for(i = 0; i < ptrs; ++i)
- DEBUG_TREE((StgPtr)node[i+vhs+_FHS]);
+ DEBUG_TREE((StgPtr)node[i+vhs+_HS]);
/* Unmark the node */
INFO_PTR(node) &= ~INFO_MASK;
#endif
#if defined(PROFILING)
- fprintf(stderr,"Cost Centre (???): 0x%lx\n",INFO_CAT(info_ptr));
+ fprintf(stderr,"Cost Centre (?): 0x%lx\n",INFO_CAT(info_ptr));
#endif
#if defined(_INFO_COPYING)
return(str);
}
-char *
-info_type(StgClosure *closure){
- return closure_type_names[get_itbl(closure)->type];
-}
-
-char *
-info_type_by_ip(StgInfoTable *ip){
- return closure_type_names[ip->type];
-}
-
-void
-info_hdr_type(StgClosure *closure, char *res){
- strcpy(res,closure_type_names[get_itbl(closure)->type]);
-}
-
/*
PrintPacket is in Pack.c because it makes use of closure queues
*/
void
PrintGraph(StgClosure *p, int indent_level)
{
+ void PrintGraph_(StgClosure *p, int indent_level);
+
+ ASSERT(tmpClosureTable==NULL);
+
+ /* init hash table */
+ tmpClosureTable = allocHashTable();
+
+ /* now do the real work */
+ PrintGraph_(p, indent_level);
+
+ /* nuke hash table */
+ freeHashTable(tmpClosureTable, NULL);
+ tmpClosureTable = NULL;
+}
+
+/*
+ This is the actual worker functions.
+ All recursive calls should be made to this function.
+*/
+void
+PrintGraph_(StgClosure *p, int indent_level)
+{
StgPtr x, q;
rtsBool printed = rtsFalse;
nat i, j;
const StgInfoTable *info;
+ /* check whether we have met this node already to break cycles */
+ if (lookupHashTable(tmpClosureTable, (StgWord)p)) { // ie. already touched
+ /* indentation */
+ for (j=0; j<indent_level; j++)
+ fputs(" ", stderr);
+
+ fprintf(stderr, "#### cylce to %p", p);
+ return;
+ }
+
+ /* record that we are processing this closure */
+ insertHashTable(tmpClosureTable, (StgWord) p, (void *)rtsTrue/*non-NULL*/);
+
q = p; /* save ptr to object */
/* indentation */
for (j=0; j<indent_level; j++)
fputs(" ", stderr);
- ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p))
- || IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p))));
+ ASSERT(p!=(StgClosure*)NULL);
+ ASSERT(LOOKS_LIKE_STATIC(p) ||
+ LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p)) ||
+ IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p)));
printClosure(p); // prints contents of this one closure
{
StgBCO* bco = stgCast(StgBCO*,p);
nat i;
- fprintf(stderr, "BCO (%p) with %d pointers\n", p, bco->n_ptrs);
+ fprintf(stderr, "BCO (%p)\n", p);
+ /*
for (i = 0; i < bco->n_ptrs; i++) {
// bcoConstCPtr(bco,i) =
- PrintGraph(bcoConstCPtr(bco,i), indent_level+1);
+ PrintGraph_(bcoConstCPtr(bco,i), indent_level+1);
}
+ */
// p += bco_sizeW(bco);
break;
}
// evac_gen = 0;
fprintf(stderr, "MVAR (%p) with 3 pointers (head, tail, value)\n", p);
// (StgClosure *)mvar->head =
- PrintGraph((StgClosure *)mvar->head, indent_level+1);
+ PrintGraph_((StgClosure *)mvar->head, indent_level+1);
// (StgClosure *)mvar->tail =
- PrintGraph((StgClosure *)mvar->tail, indent_level+1);
+ PrintGraph_((StgClosure *)mvar->tail, indent_level+1);
//(StgClosure *)mvar->value =
- PrintGraph((StgClosure *)mvar->value, indent_level+1);
+ PrintGraph_((StgClosure *)mvar->value, indent_level+1);
// p += sizeofW(StgMVar);
// evac_gen = saved_evac_gen;
break;
printed = rtsTrue;
}
// ((StgClosure *)p)->payload[0] =
- PrintGraph(((StgClosure *)p)->payload[0],
+ PrintGraph_(((StgClosure *)p)->payload[0],
indent_level+1);
// ((StgClosure *)p)->payload[1] =
- PrintGraph(((StgClosure *)p)->payload[1],
+ PrintGraph_(((StgClosure *)p)->payload[1],
indent_level+1);
// p += sizeofW(StgHeader) + 2;
break;
// scavenge_srt(info);
fprintf(stderr, "THUNK_1_0 (%p) with 1 pointer\n", p);
// ((StgClosure *)p)->payload[0] =
- PrintGraph(((StgClosure *)p)->payload[0],
+ PrintGraph_(((StgClosure *)p)->payload[0],
indent_level+1);
// p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
break;
printed = rtsTrue;
}
// ((StgClosure *)p)->payload[0] =
- PrintGraph(((StgClosure *)p)->payload[0],
+ PrintGraph_(((StgClosure *)p)->payload[0],
indent_level+1);
// p += sizeofW(StgHeader) + 1;
break;
printed = rtsTrue;
}
// ((StgClosure *)p)->payload[0] =
- PrintGraph(((StgClosure *)p)->payload[0],
+ PrintGraph_(((StgClosure *)p)->payload[0],
indent_level+1);
// p += sizeofW(StgHeader) + 2;
break;
}
/* basically same as loop in STABLE_NAME case */
for (i=0; i<info->layout.payload.ptrs; i++)
- PrintGraph(((StgClosure *)p)->payload[i],
+ PrintGraph_(((StgClosure *)p)->payload[i],
indent_level+1);
break;
/* NOT fall through */
end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
// (StgClosure *)*p =
- //PrintGraph((StgClosure *)*p, indent_level+1);
+ //PrintGraph_((StgClosure *)*p, indent_level+1);
fprintf(stderr, ", %p", *p);
}
//fputs("\n", stderr);
printed = rtsTrue;
}
// ((StgIndOldGen *)p)->indirectee =
- PrintGraph(((StgIndOldGen *)p)->indirectee,
+ PrintGraph_(((StgIndOldGen *)p)->indirectee,
indent_level+1);
//if (failed_to_evac) {
// failed_to_evac = rtsFalse;
// p += sizeofW(StgIndOldGen);
break;
- case CAF_UNENTERED:
- {
- StgCAF *caf = (StgCAF *)p;
-
- fprintf(stderr, "CAF_UNENTERED (%p) pointing to %p\n", p, caf->body);
- PrintGraph(caf->body, indent_level+1);
- //if (failed_to_evac) {
- // failed_to_evac = rtsFalse;
- // recordOldToNewPtrs((StgMutClosure *)p);
- //} else {
- // caf->mut_link = NULL;
- //}
- //p += sizeofW(StgCAF);
- break;
- }
-
- case CAF_ENTERED:
- {
- StgCAF *caf = (StgCAF *)p;
-
- fprintf(stderr, "CAF_ENTERED (%p) pointing to %p and %p\n",
- p, caf->body, caf->value);
- // caf->body =
- PrintGraph(caf->body, indent_level+1);
- //caf->value =
- PrintGraph(caf->value, indent_level+1);
- //if (failed_to_evac) {
- // failed_to_evac = rtsFalse;
- // recordOldToNewPtrs((StgMutClosure *)p);
- //} else {
- // caf->mut_link = NULL;
- //}
- //p += sizeofW(StgCAF);
- break;
- }
-
case MUT_VAR:
/* ignore MUT_CONSs */
fprintf(stderr, "MUT_VAR (%p) pointing to %p\n", p, ((StgMutVar *)p)->var);
- if (((StgMutVar *)p)->header.info != &MUT_CONS_info) {
+ if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
//evac_gen = 0;
- PrintGraph(((StgMutVar *)p)->var, indent_level+1);
+ PrintGraph_(((StgMutVar *)p)->var, indent_level+1);
//evac_gen = saved_evac_gen;
}
//p += sizeofW(StgMutVar);
// (StgClosure *)bh->blocking_queue =
fprintf(stderr, "BLACKHOLE_BQ (%p) pointing to %p\n",
p, (StgClosure *)bh->blocking_queue);
- PrintGraph((StgClosure *)bh->blocking_queue, indent_level+1);
+ PrintGraph_((StgClosure *)bh->blocking_queue, indent_level+1);
//if (failed_to_evac) {
// failed_to_evac = rtsFalse;
// recordMutable((StgMutClosure *)bh);
StgSelector *s = (StgSelector *)p;
fprintf(stderr, "THUNK_SELECTOR (%p) pointing to %p\n",
p, s->selectee);
- PrintGraph(s->selectee, indent_level+1);
+ PrintGraph_(s->selectee, indent_level+1);
// p += THUNK_SELECTOR_sizeW();
break;
}
case IND:
fprintf(stderr, "IND (%p) pointing to %p\n", p, ((StgInd*)p)->indirectee);
- PrintGraph(((StgInd*)p)->indirectee, indent_level+1);
+ PrintGraph_(((StgInd*)p)->indirectee, indent_level+1);
break;
case IND_OLDGEN:
fprintf(stderr, "IND_OLDGEN (%p) pointing to %p\n",
p, ((StgIndOldGen*)p)->indirectee);
- PrintGraph(((StgIndOldGen*)p)->indirectee, indent_level+1);
+ PrintGraph_(((StgIndOldGen*)p)->indirectee, indent_level+1);
break;
case CONSTR_INTLIKE:
fprintf(stderr, "AP_UPD (%p) with 0 pointers\n", p);
case PAP:
/* Treat a PAP just like a section of stack, not forgetting to
- * PrintGraph the function pointer too...
+ * PrintGraph_ the function pointer too...
*/
{
StgPAP* pap = stgCast(StgPAP*,p);
fprintf(stderr, "PAP (%p) pointing to %p\n", p, pap->fun);
// pap->fun =
- PrintGraph(pap->fun, indent_level+1);
+ //PrintGraph_(pap->fun, indent_level+1);
//scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
//p += pap_sizeW(pap);
break;
}
case ARR_WORDS:
- fprintf(stderr, "ARR_WORDS (%p) with 0 pointers\n", p);
- /* nothing to follow */
- //p += arr_words_sizeW(stgCast(StgArrWords*,p));
+ /* an array of (non-mutable) words */
+ fprintf(stderr, "ARR_WORDS (%p) of %d non-ptrs (maybe a string?)\n",
+ p, ((StgArrWords *)q)->words);
break;
-
+
case MUT_ARR_PTRS:
/* follow everything */
{
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
// (StgClosure *)*p =
- // PrintGraph((StgClosure *)*p, indent_level+1);
+ // PrintGraph_((StgClosure *)*p, indent_level+1);
fprintf(stderr, ", %p", *p);
}
fputs("\n", stderr);
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
// (StgClosure *)*p =
- // PrintGraph((StgClosure *)*p, indent_level+1);
+ // PrintGraph_((StgClosure *)*p, indent_level+1);
fprintf(stderr, ", %p", *p);
}
fputs("\n", stderr);
// evac_gen = 0;
/* chase the link field for any TSOs on the same queue */
// (StgClosure *)tso->link =
- PrintGraph((StgClosure *)tso->link, indent_level+1);
+ PrintGraph_((StgClosure *)tso->link, indent_level+1);
//if (tso->blocked_on) {
- // tso->blocked_on = PrintGraph(tso->blocked_on);
+ // tso->blocked_on = PrintGraph_(tso->blocked_on);
//}
/* scavenge this thread's stack */
//scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
p, ((StgFetchMeBlockingQueue *)p)->blocking_queue);
break;
#endif
+
+#ifdef DIST
+ case REMOTE_REF:
+ fprintf(stderr, "REMOTE_REF (%p) with 0 pointers\n", p);
+ break;
+#endif
+
case EVACUATED:
fprintf(stderr, "EVACUATED (%p) with 0 pointers (evacuee=%p)\n",
p, ((StgEvacuated *)p)->evacuee);
break;
default:
- barf("PrintGraph: unknown closure %d (%s)",
+ barf("PrintGraph_: unknown closure %d (%s)",
info -> type, info_type(info));
}
//}
}
-#endif /* GRAN */
+# if defined(PAR)
+/*
+ Generate a finger-print for a graph.
+ A finger-print is a string, with each char representing one node;
+ depth-first traversal
+*/
-#endif /* GRAN || PAR */
+void
+GraphFingerPrint(StgClosure *p, char *finger_print)
+{
+ void GraphFingerPrint_(StgClosure *p, char *finger_print);
-#if !defined(GRAN) && !defined(PAR)
-// just dummy defs in this setup
-#include "Rts.h"
-#include "ParallelDebug.h"
+ ASSERT(tmpClosureTable==NULL);
+ ASSERT(strlen(finger_print)==0);
-char *
-info_type(StgClosure *closure){
- return "petaQ";
-}
+ /* init hash table */
+ tmpClosureTable = allocHashTable();
-char *
-info_type_by_ip(StgInfoTable *ip){
- return "petaQ";
+ /* now do the real work */
+ GraphFingerPrint_(p, finger_print);
+
+ /* nuke hash table */
+ freeHashTable(tmpClosureTable, NULL);
+ tmpClosureTable = NULL;
}
+/*
+ This is the actual worker functions.
+ All recursive calls should be made to this function.
+*/
void
-info_hdr_type(StgClosure *closure, char *res){
- strcpy(res,"petaQ");
-}
+GraphFingerPrint_(StgClosure *p, char *finger_print)
+{
+ StgPtr x, q;
+ rtsBool printed = rtsFalse;
+ nat i, j, len;
+ const StgInfoTable *info;
+
+ q = p; /* save ptr to object */
+ len = strlen(finger_print);
+ ASSERT(len<=MAX_FINGER_PRINT_LEN);
+ /* at most 7 chars for this node (I think) */
+ if (len+7>=MAX_FINGER_PRINT_LEN)
+ return;
+
+ /* check whether we have met this node already to break cycles */
+ if (lookupHashTable(tmpClosureTable, (StgWord)p)) { // ie. already touched
+ strcat(finger_print, "#");
+ return;
+ }
+
+ /* record that we are processing this closure */
+ insertHashTable(tmpClosureTable, (StgWord) p, (void *)rtsTrue/*non-NULL*/);
+
+ ASSERT(p!=(StgClosure*)NULL);
+ ASSERT(LOOKS_LIKE_STATIC(p) ||
+ LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p)) ||
+ IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p)));
+
+ info = get_itbl((StgClosure *)p);
+ // append char for this node
+ finger_print[len] = finger_print_char[info->type]; finger_print[len+1] = '\0';
+ /* the rest of this fct recursively traverses the graph */
+ switch (info -> type) {
+
+ case BCO:
+ {
+ StgBCO* bco = stgCast(StgBCO*,p);
+ nat i;
+ //%% fprintf(stderr, "BCO (%p) with %d pointers\n", p, bco->n_ptrs);
+ /*
+ for (i = 0; i < bco->n_ptrs; i++) {
+ // bcoConstCPtr(bco,i) =
+ GraphFingerPrint_(bcoConstCPtr(bco,i), finger_print);
+ }
+ */
+ // p += bco_sizeW(bco);
+ break;
+ }
+
+ case MVAR:
+ break;
+
+ case THUNK_2_0:
+ case FUN_2_0:
+ case CONSTR_2_0:
+ // append char for this node
+ strcat(finger_print, "22(");
+ GraphFingerPrint_(((StgClosure *)p)->payload[0], finger_print);
+ GraphFingerPrint_(((StgClosure *)p)->payload[1], finger_print);
+ if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
+ strcat(finger_print, ")");
+ break;
+
+ case THUNK_1_0:
+ case FUN_1_0:
+ case CONSTR_1_0:
+ // append char for this node
+ strcat(finger_print, "12(");
+ GraphFingerPrint_(((StgClosure *)p)->payload[0], finger_print);
+ if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
+ strcat(finger_print, ")");
+ break;
+
+ case THUNK_0_1:
+ case FUN_0_1:
+ case CONSTR_0_1:
+ // append char for this node
+ strcat(finger_print, "01");
+ break;
+
+ case THUNK_0_2:
+ case FUN_0_2:
+ case CONSTR_0_2:
+ // append char for this node
+ strcat(finger_print, "02");
+ break;
+
+ case THUNK_1_1:
+ case FUN_1_1:
+ case CONSTR_1_1:
+ // append char for this node
+ strcat(finger_print, "11(");
+ GraphFingerPrint_(((StgClosure *)p)->payload[0], finger_print);
+ if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
+ strcat(finger_print, ")");
+ break;
+
+ case FUN:
+ case THUNK:
+ case CONSTR:
+ /* basically same as loop in STABLE_NAME case */
+ {
+ char str[6];
+ sprintf(str,"%d?(",info->layout.payload.ptrs);
+ strcat(finger_print,str);
+ for (i=0; i<info->layout.payload.ptrs; i++)
+ GraphFingerPrint_(((StgClosure *)p)->payload[i], finger_print);
+ if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
+ strcat(finger_print, ")");
+ }
+ break;
+
+ case WEAK:
+ case FOREIGN:
+ case STABLE_NAME:
+ {
+ StgPtr end;
+ char str[6];
+ sprintf(str,"%d?", info->layout.payload.ptrs);
+ strcat(finger_print,str);
+
+ //end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
+ //for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
+ // GraphFingerPrint_((StgClosure *)*p, finger_print);
+ //}
+ break;
+ }
+
+ case IND_PERM:
+ case IND_OLDGEN_PERM:
+ GraphFingerPrint_(((StgIndOldGen *)p)->indirectee, finger_print);
+ break;
+
+ case MUT_VAR:
+ /* ignore MUT_CONSs */
+ if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
+ GraphFingerPrint_(((StgMutVar *)p)->var, finger_print);
+ }
+ break;
+
+ case CAF_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
+ case SE_BLACKHOLE:
+ case BLACKHOLE:
+ break;
+
+ case BLACKHOLE_BQ:
+ {
+ StgBlockingQueue *bh = (StgBlockingQueue *)p;
+ // GraphFingerPrint_((StgClosure *)bh->blocking_queue, finger_print);
+ break;
+ }
+
+ case THUNK_SELECTOR:
+ {
+ StgSelector *s = (StgSelector *)p;
+ GraphFingerPrint_(s->selectee, finger_print);
+ break;
+ }
+
+ case IND:
+ GraphFingerPrint_(((StgInd*)p)->indirectee, finger_print);
+ break;
+
+ case IND_OLDGEN:
+ GraphFingerPrint_(((StgIndOldGen*)p)->indirectee, finger_print);
+ break;
+
+ case IND_STATIC:
+ GraphFingerPrint_(((StgIndOldGen*)p)->indirectee, finger_print);
+ break;
+
+ case CONSTR_INTLIKE:
+ case CONSTR_CHARLIKE:
+ case CONSTR_STATIC:
+ case CONSTR_NOCAF_STATIC:
+ case THUNK_STATIC:
+ case FUN_STATIC:
+ break;
+
+ case RET_BCO:
+ case RET_SMALL:
+ case RET_VEC_SMALL:
+ case RET_BIG:
+ case RET_VEC_BIG:
+ case RET_DYN:
+ case UPDATE_FRAME:
+ case STOP_FRAME:
+ case CATCH_FRAME:
+ case SEQ_FRAME:
+ break;
+
+ case AP_UPD: /* same as PAPs */
+ case PAP:
+ /* Treat a PAP just like a section of stack, not forgetting to
+ * GraphFingerPrint_ the function pointer too...
+ */
+ {
+ StgPAP* pap = stgCast(StgPAP*,p);
+ char str[6];
+ sprintf(str,"%d",pap->n_args);
+ strcat(finger_print,str);
+ //GraphFingerPrint_(pap->fun, finger_print); // ??
+ break;
+ }
+
+ case ARR_WORDS:
+ {
+ char str[6];
+ sprintf(str,"%d",((StgArrWords*)p)->words);
+ strcat(finger_print,str);
+ }
+ break;
+
+ case MUT_ARR_PTRS:
+ /* follow everything */
+ {
+ char str[6];
+ sprintf(str,"%d",((StgMutArrPtrs*)p)->ptrs);
+ strcat(finger_print,str);
+ }
+ {
+ StgPtr next;
+ //next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+ //for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
+ // GraphFingerPrint_((StgClosure *)*p, finger_print);
+ //}
+ break;
+ }
+
+ case MUT_ARR_PTRS_FROZEN:
+ /* follow everything */
+ {
+ char str[6];
+ sprintf(str,"%d",((StgMutArrPtrs*)p)->ptrs);
+ strcat(finger_print,str);
+ }
+ {
+ StgPtr start = p, next;
+ //next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+ //for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
+ // GraphFingerPrint_((StgClosure *)*p, finger_print);
+ //}
+ break;
+ }
+
+ case TSO:
+ {
+ StgTSO *tso = (StgTSO *)p;
+ char str[6];
+ sprintf(str,"%d",tso->id);
+ strcat(finger_print,str);
+ }
+ //GraphFingerPrint_((StgClosure *)tso->link, indent_level+1);
+ break;
+
+#if defined(GRAN) || defined(PAR)
+ case RBH:
+ {
+ // use this
+ // StgInfoTable *rip = REVERT_INFOPTR(get_itbl(p));
+ }
+ break;
+#endif
+#if defined(PAR)
+ case BLOCKED_FETCH:
+ break;
+ case FETCH_ME:
+ break;
+ case FETCH_ME_BQ:
+ break;
+#endif
+#ifdef DIST
+ case REMOTE_REF:
+ break;
+#endif
+ case EVACUATED:
+ break;
+
+ default:
+ barf("GraphFingerPrint_: unknown closure %d (%s)",
+ info -> type, info_type(info));
+ }
+
+}
+# endif /* PAR */
+
+/*
+ Do a sanity check on the whole graph, down to a recursion level of level.
+ Same structure as PrintGraph (nona).
+*/
+void
+checkGraph(StgClosure *p, int rec_level)
+{
+ StgPtr x, q;
+ nat i, j;
+ const StgInfoTable *info;
+
+ if (rec_level==0)
+ return;
+
+ q = p; /* save ptr to object */
+
+ /* First, the obvious generic checks */
+ ASSERT(p!=(StgClosure*)NULL);
+ checkClosure(p); /* see Sanity.c for what's actually checked */
+
+ info = get_itbl((StgClosure *)p);
+ /* the rest of this fct recursively traverses the graph */
+ switch (info -> type) {
+
+ case BCO:
+ {
+ StgBCO* bco = stgCast(StgBCO*,p);
+ nat i;
+ /*
+ for (i = 0; i < bco->n_ptrs; i++) {
+ checkGraph(bcoConstCPtr(bco,i), rec_level-1);
+ }
+ */
+ break;
+ }
+
+ case MVAR:
+ /* treat MVars specially, because we don't want to PrintGraph the
+ * mut_link field in the middle of the closure.
+ */
+ {
+ StgMVar *mvar = ((StgMVar *)p);
+ checkGraph((StgClosure *)mvar->head, rec_level-1);
+ checkGraph((StgClosure *)mvar->tail, rec_level-1);
+ checkGraph((StgClosure *)mvar->value, rec_level-1);
+ break;
+ }
+
+ case THUNK_2_0:
+ case FUN_2_0:
+ case CONSTR_2_0:
+ checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
+ checkGraph(((StgClosure *)p)->payload[1], rec_level-1);
+ break;
+
+ case THUNK_1_0:
+ checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
+ break;
+
+ case FUN_1_0:
+ case CONSTR_1_0:
+ checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
+ break;
+
+ case THUNK_0_1:
+ break;
+
+ case FUN_0_1:
+ case CONSTR_0_1:
+ break;
+
+ case THUNK_0_2:
+ case FUN_0_2:
+ case CONSTR_0_2:
+ break;
+
+ case THUNK_1_1:
+ case FUN_1_1:
+ case CONSTR_1_1:
+ checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
+ break;
+
+ case FUN:
+ case THUNK:
+ case CONSTR:
+ for (i=0; i<info->layout.payload.ptrs; i++)
+ checkGraph(((StgClosure *)p)->payload[i], rec_level-1);
+ break;
+
+ case WEAK:
+ case FOREIGN:
+ case STABLE_NAME:
+ {
+ StgPtr end;
+
+ end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
+ for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
+ checkGraph(*(StgClosure **)p, rec_level-1);
+ }
+ break;
+ }
+
+ case IND_PERM:
+ case IND_OLDGEN_PERM:
+ checkGraph(((StgIndOldGen *)p)->indirectee, rec_level-1);
+ break;
+
+ case MUT_VAR:
+ /* ignore MUT_CONSs */
+ if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
+ checkGraph(((StgMutVar *)p)->var, rec_level-1);
+ }
+ break;
+
+ case CAF_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
+ case SE_BLACKHOLE:
+ case BLACKHOLE:
+ break;
+
+ case BLACKHOLE_BQ:
+ break;
+
+ case THUNK_SELECTOR:
+ {
+ StgSelector *s = (StgSelector *)p;
+ checkGraph(s->selectee, rec_level-1);
+ break;
+ }
+
+ case IND:
+ checkGraph(((StgInd*)p)->indirectee, rec_level-1);
+ break;
+
+ case IND_OLDGEN:
+ checkGraph(((StgIndOldGen*)p)->indirectee, rec_level-1);
+ break;
+
+ case CONSTR_INTLIKE:
+ break;
+ case CONSTR_CHARLIKE:
+ break;
+ case CONSTR_STATIC:
+ break;
+ case CONSTR_NOCAF_STATIC:
+ break;
+ case THUNK_STATIC:
+ break;
+ case FUN_STATIC:
+ break;
+ case IND_STATIC:
+ break;
+
+ case RET_BCO:
+ break;
+ case RET_SMALL:
+ break;
+ case RET_VEC_SMALL:
+ break;
+ case RET_BIG:
+ break;
+ case RET_VEC_BIG:
+ break;
+ case RET_DYN:
+ break;
+ case UPDATE_FRAME:
+ break;
+ case STOP_FRAME:
+ break;
+ case CATCH_FRAME:
+ break;
+ case SEQ_FRAME:
+ break;
+
+ case AP_UPD: /* same as PAPs */
+ case PAP:
+ /* Treat a PAP just like a section of stack, not forgetting to
+ * checkGraph the function pointer too...
+ */
+ {
+ StgPAP* pap = stgCast(StgPAP*,p);
+
+ checkGraph(pap->fun, rec_level-1);
+ break;
+ }
+
+ case ARR_WORDS:
+ break;
+
+ case MUT_ARR_PTRS:
+ /* follow everything */
+ {
+ StgPtr next;
+
+ next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+ for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
+ checkGraph(*(StgClosure **)p, rec_level-1);
+ }
+ break;
+ }
+
+ case MUT_ARR_PTRS_FROZEN:
+ /* follow everything */
+ {
+ StgPtr start = p, next;
+
+ next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+ for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
+ checkGraph(*(StgClosure **)p, rec_level-1);
+ }
+ break;
+ }
+
+ case TSO:
+ {
+ StgTSO *tso;
+
+ tso = (StgTSO *)p;
+ checkGraph((StgClosure *)tso->link, rec_level-1);
+ break;
+ }
+
+#if defined(GRAN) || defined(PAR)
+ case RBH:
+ break;
+#endif
+#if defined(PAR)
+ case BLOCKED_FETCH:
+ break;
+ case FETCH_ME:
+ break;
+ case FETCH_ME_BQ:
+ break;
+#endif
+ case EVACUATED:
+ barf("checkGraph: found EVACUATED closure %p (%s)",
+ p, info_type(p));
+ break;
+
+ default:
+ }
+}
+
+#endif /* GRAN */
+
#endif /* GRAN || PAR */
//@node End of File, , Printing Packet Contents, Debugging routines for GranSim and GUM
projects / ghc-hetmet.git / blobdiff