1 \section[StgDebug]{Useful debugging routines for the STG machine}
3 Call these functions directly from a debugger to print Nodes,
4 registers, stacks, etc.
8 make EXTRA_HC_OPTS='-optl-u -optl_DEBUG_LoadSymbols' ghci
10 is usually required to get this code included in the object code.)
12 Nota Bene: in a registerised build, you have to save all the registers
13 in their appropriate SAVE locations before calling any code that needs
14 register contents. (This has to be repeated every time you emerge
17 On a sparc, this can be done by the following gdb script
21 set *(&MainRegTable+8) = $l1
22 set *(&MainRegTable+9) = $l2
23 set *(&MainRegTable+10) = $l3
24 set *(&MainRegTable+11) = $l4
25 set *(&MainRegTable+12) = $l5
26 set *(&MainRegTable+13) = $l6
27 set *(&MainRegTable+14) = $l7
28 set *(&MainRegTable+4) = $f2
29 set *(&MainRegTable+5) = $f3
30 set *(&MainRegTable+6) = $f4
31 set *(&MainRegTable+7) = $f5
33 set *((double *) &MainRegTable+0) = (double) $f6
34 set *((double *) &MainRegTable+2) = (double) $f8
35 set *(&MainRegTable+23) = $l0
36 set *(&MainRegTable+16) = $i0
37 set *(&MainRegTable+17) = $i1
38 set *(&MainRegTable+18) = $i2
39 set *(&MainRegTable+19) = $i3
40 set *(&StorageMgrInfo+0) = $i4
41 set *(&StorageMgrInfo+1) = $i5
46 New code (attempts to interpret heap/stack contents)
47 DEBUG_LoadSymbols( filename ) Load symbol table from object file
48 (not essential but useful initialisation)
49 DEBUG_PrintA( depth, size ) Print "depth" entries from A stack
50 DEBUG_PrintB( depth, size ) ditto
51 DEBUG_Where( depth, size ) Ambitious attempt to print stacks
52 symbolically. Result is a little inaccurate
53 but often good enough to do the job.
54 DEBUG_NODE( closure, size ) Print a closure on the heap
55 DEBUG_INFO_TABLE(closure) Print info-table of a closure
56 DEBUG_SPT( size ) Print the Stable Pointer Table
58 (Use variable DEBUG_details to set level of detail shown.)
60 Older code (less fancy ==> more reliable)
61 DEBUG_ASTACK(lines) Print "lines" lines of the A Stack
62 DEBUG_BSTACK(lines) Print "lines" lines of the B Stack
63 DEBUG_UPDATES(frames) Print "frames" update frames
64 DEBUG_REGS() Print register values
65 DEBUG_FO() Print the ForeignObj Lists
66 DEBUG_TSO(tso) (CONCURRENT) Print a Thread State Object
69 DEBUG_STKO(stko) (CONCURRENT) Print a STacK Object
75 \subsection[StgDebug_Symbol_Tables]{Loading Symbol Tables}
77 NB: this assumes a.out files - won't work on Alphas.
78 ToDo: At least add some #ifdefs
81 /* #include <a.out.h> */
82 /* #include <stab.h> */
83 /* #include <nlist.h> */
87 #define FROM_START 0 /* for fseek */
89 /* Simple lookup table */
91 /* Current implementation is pretty dumb! */
99 static int table_uninitialised = 1;
100 static int max_table_size;
101 static int table_size;
102 static struct entry* table;
105 reset_table( int size )
107 max_table_size = size;
109 table = (struct entry *) stgMallocBytes(size * sizeof(struct entry), "reset_table");
115 /* Could sort it... */
119 insert( unsigned value, int index, char *name )
121 if ( table_size >= max_table_size ) {
122 fprintf( stderr, "Symbol table overflow\n" );
125 table[table_size].value = value;
126 table[table_size].index = index;
127 table[table_size].name = name;
128 table_size = table_size + 1;
132 lookup( unsigned value, int *result )
135 for( i = 0; i < table_size && table[i].value != value; ++i ) {
137 if (i < table_size) {
138 *result = table[i].index;
146 lookup_name( char *name, unsigned *result )
149 for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) {
151 if (i < table_size) {
152 *result = table[i].value;
161 "std"++xs -> "Zstd"++xs
175 char_to_c '\'' = "Zq"
178 char_to_c c = "Z" ++ show (ord c)
181 static char unZcode( char ch )
222 /* Precondition: out big enough to handle output (about twice length of in) */
223 static void enZcode( char *in, char *out )
229 for( i = 0; in[i] != '\0'; ++i ) {
305 static int lookupForName( P_ addr, char **result )
308 for( i = 0; i < table_size && table[i].value != (unsigned) addr; ++i ) {
310 if (i < table_size) {
311 *result = table[i].name;
318 static void printZcoded( char *raw )
322 /* start at 1 to skip the leading "_" */
323 for( j = 1; raw[j] != '\0'; /* explicit */) {
325 putchar(unZcode(raw[j+1]));
334 static void printName( P_ addr )
338 if (lookupForName( addr, &raw )) {
341 printf("0x%x", addr);
345 #if 0 /* OMIT load-symbol stuff cos it doesn't work on Alphas */
347 /* Fairly ad-hoc piece of code that seems to filter out a lot of
348 rubbish like the obj-splitting symbols */
351 isReal( unsigned char type, char *name )
353 int external = type & N_EXT;
354 int tp = type & N_TYPE;
356 if (tp == N_TEXT || tp == N_DATA) {
357 return( name[0] == '_' && name[1] != '_' );
364 DEBUG_LoadSymbols( char *name )
374 struct nlist *symbol_table;
377 long str_size; /* assumed 4 bytes.... */
382 binary = fopen( name, "r" );
383 if (binary == NULL) {
384 fprintf( stderr, "Can't open symbol table file \"%s\".\n", name );
388 if (fread( &header, sizeof( struct exec ), 1, binary ) != 1) {
389 fprintf( stderr, "Can't read symbol table header.\n" );
392 if ( N_BADMAG( header ) ) {
393 fprintf( stderr, "Bad magic number in symbol table header.\n" );
399 sym_offset = N_SYMOFF( header );
400 sym_size = header.a_syms;
401 num_syms = sym_size / sizeof( struct nlist );
402 fseek( binary, sym_offset, FROM_START );
404 symbol_table = (struct nlist *) stgMallocBytes(sym_size, "symbol table (DEBUG_LoadSymbols)");
405 printf("Reading %d symbols\n", num_syms);
407 if (fread( symbol_table, sym_size, 1, binary ) != 1) {
408 fprintf( stderr, "Can't read symbol table\n");
412 str_offset = N_STROFF( header );
413 fseek( binary, str_offset, FROM_START );
415 if (fread( &str_size, 4, 1, binary ) != 1) {
416 fprintf( stderr, "Can't read string table size\n");
420 /* apparently the size of the string table includes the 4 bytes that
423 string_table = (char *) stgMallocBytes(str_size, "string table (DEBUG_LoadSymbols)");
425 if (fread( string_table+4, str_size-4, 1, binary ) != 1) {
426 fprintf( stderr, "Can't read string table\n");
431 for( i = 0; i != num_syms; ++i ) {
432 unsigned char type = symbol_table[i].n_type;
433 unsigned value = symbol_table[i].n_value;
434 char *str = &string_table[symbol_table[i].n_un.n_strx];
436 if ( isReal( type, str ) ) {
437 num_real_syms = num_real_syms + 1;
441 printf("Of which %d are real symbols\n", num_real_syms);
444 for( i = 0; i != num_syms; ++i ) {
445 unsigned char type = symbol_table[i].n_type;
446 unsigned value = symbol_table[i].n_value;
447 char *str = &string_table[symbol_table[i].n_un.n_strx];
449 if ( isReal(type, str) ) {
450 printf("Symbol %d. Extern? %c. Type: %c. Value: 0x%x. Name: %s\n",
452 (external ? 'y' : 'n'),
461 reset_table( num_real_syms );
463 for( i = 0; i != num_syms; ++i ) {
464 unsigned char type = symbol_table[i].n_type;
465 unsigned value = symbol_table[i].n_value;
466 char *str = &string_table[symbol_table[i].n_un.n_strx];
468 if ( isReal( type, str ) ) {
469 insert( value, i, str );
479 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
481 \subsection[StgDebug_PrettyPrinting]{Pretty printing internal structures}
483 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
486 #include "../storage/SMinternal.h"
489 #define HP_BOT appelInfo.oldbase
491 #define HP_BOT dualmodeInfo.modeinfo[dualmodeInfo.mode].base
493 #define HP_BOT semispaceInfo[semispace].base
495 #define HP_BOT compactingInfo.base
497 unknown garbage collector - help, help!
502 /* range: 0..NUM_LEVELS_OF_DETAIL-1. Level of machine-related detail shown */
503 #define NUM_LEVELS_OF_DETAIL 3
504 static int DEBUG_details = 2;
508 /* Determine the size and number of pointers for this kind of closure */
510 getClosureShape( P_ node, int *vhs, int *size, int *ptrs, char **type )
512 /* The result is used for printing out closure contents. If the
513 info-table is mince, we'd better conservatively guess there's
514 nothing in the closure to avoid chasing non-ptrs. */
518 *type = "*unknown info type*";
520 /* ToDo: if in garbage collector, consider subtracting some weird offset which some GCs add to infoptr */
522 /* The order here precisely reflects that in SMInfoTables.lh to make
523 it easier to check that this list is complete. */
524 switch(INFO_TYPE(INFO_PTR(node)))
526 case INFO_SPEC_U_TYPE:
527 *vhs = 0; /* by decree */
528 *size = SPEC_CLOSURE_SIZE(node);
529 *ptrs = SPEC_CLOSURE_NoPTRS(node);
532 case INFO_SPEC_N_TYPE:
533 *vhs = 0; /* by decree */
534 *size = SPEC_CLOSURE_SIZE(node);
535 *ptrs = SPEC_CLOSURE_NoPTRS(node);
539 case INFO_GEN_U_TYPE:
541 *size = GEN_CLOSURE_SIZE(node);
542 *ptrs = GEN_CLOSURE_NoPTRS(node);
545 case INFO_GEN_N_TYPE:
547 *size = GEN_CLOSURE_SIZE(node);
548 *ptrs = GEN_CLOSURE_NoPTRS(node);
554 *size = DYN_CLOSURE_SIZE(node);
555 *ptrs = DYN_CLOSURE_NoPTRS(node);
559 case INFO_TUPLE_TYPE:
561 *size = TUPLE_CLOSURE_SIZE(node);
562 *ptrs = TUPLE_CLOSURE_NoPTRS(node);
568 *size = DATA_CLOSURE_SIZE(node);
569 *ptrs = DATA_CLOSURE_NoPTRS(node);
573 case INFO_MUTUPLE_TYPE:
575 *size = MUTUPLE_CLOSURE_SIZE(node);
576 *ptrs = MUTUPLE_CLOSURE_NoPTRS(node);
580 case INFO_IMMUTUPLE_TYPE:
582 *size = MUTUPLE_CLOSURE_SIZE(node);
583 *ptrs = MUTUPLE_CLOSURE_NoPTRS(node);
587 case INFO_STATIC_TYPE:
589 *size = INFO_SIZE(INFO_PTR(node));
590 *ptrs = INFO_NoPTRS(INFO_PTR(node));
594 case INFO_CONST_TYPE:
601 case INFO_CHARLIKE_TYPE:
608 case INFO_INTLIKE_TYPE:
617 *size = INFO_SIZE(INFO_PTR(node));
622 /* most of the following are plausible guesses (particularily VHSs) ADR */
626 *size = BQ_CLOSURE_SIZE(node);
627 *ptrs = BQ_CLOSURE_NoPTRS(node);
630 printf("Panic: found BQ Infotable in non-threaded system.\n");
636 *size = IND_CLOSURE_SIZE(node);
637 *ptrs = IND_CLOSURE_NoPTRS(node);
642 *vhs = 0; /* ?? ADR */
643 *size = INFO_SIZE(INFO_PTR(node));
648 case INFO_FETCHME_TYPE:
651 *size = FETCHME_CLOSURE_SIZE(node);
652 *ptrs = FETCHME_CLOSURE_NoPTRS(node);
655 printf("Panic: found FETCHME Infotable in sequential system.\n");
662 *size = FMBQ_CLOSURE_SIZE(node);
663 *ptrs = FMBQ_CLOSURE_NoPTRS(node);
666 printf("Panic: found FMBQ Infotable in sequential system.\n");
675 *type = "BlockedFetch";
677 printf("Panic: found BlockedFetch Infotable in sequential system.\n");
682 /* Conservative underestimate: this will contain a regtable
683 which comes nowhere near fitting the standard "p ptrs; s-p
684 non-ptrs" format. ADR */
691 printf("Panic: found TSO Infotable in non-threaded system.\n");
696 /* Conservative underestimate: this will contain stuff
697 which comes nowhere near fitting the standard "p ptrs; s-p
698 non-ptrs" format. JSM */
705 printf("Panic: found STKO Infotable in non-threaded system.\n");
709 /* There are no others in SMInfoTables.lh 11/5/94 ADR*/
711 printf("Invalid/unknown info type %ld\n", INFO_TYPE(INFO_PTR(node)));
719 printf("0x%08lx", word);
723 printAddress( P_ address )
726 PP_ SpA = STKO_SpA(SAVE_StkO);
727 PP_ SuA = STKO_SuA(SAVE_StkO);
728 P_ SpB = STKO_SpB(SAVE_StkO);
729 P_ SuB = STKO_SuB(SAVE_StkO);
730 PP_ botA = 0; /* junk */
732 # define CAN_SEE_STK_BOTTOMS 0
738 PP_ botA = stackInfo.botA;
739 P_ botB = stackInfo.botB;
740 # define CAN_SEE_STK_BOTTOMS 1
748 /* ToDo: check if it's in text or data segment. */
750 /* The @-1@s in stack comparisons are because we sometimes use the
751 address of just below the stack... */
754 if (lookupForName( address, &name )) {
760 if (DEBUG_details > 1) {
761 printWord( (W_) address );
764 if (HpBot <= address && address < Hp) {
765 printf("Hp[%d]", address - HpBot);
766 } else if ( CAN_SEE_STK_BOTTOMS
767 && SUBTRACT_A_STK((PP_)address, botA) >= -1
768 && SUBTRACT_A_STK(SpA, (PP_)address) >= 0) {
769 printf("SpA[%d]", SUBTRACT_A_STK((PP_)address, botA));
771 } else if ( CAN_SEE_STK_BOTTOMS
772 && SUBTRACT_B_STK(address, botB) >= -1
773 && SUBTRACT_B_STK(SpB, address) >= 0) {
774 /* ToDo: check if it's an update frame */
775 printf("SpB[%d]", SUBTRACT_B_STK(address, botB));
778 printWord( (W_) address );
784 printIndentation( int indentation )
787 for (i = 0; i < indentation; ++i) { printf(" "); }
790 /* The weight parameter is used to (eventually) break cycles */
792 printStandardShapeClosure(
795 P_ closure, int vhs, int size, int noPtrs
799 PP_ SpA = STKO_SpA(SAVE_StkO);
800 PP_ SuA = STKO_SuA(SAVE_StkO);
801 P_ SpB = STKO_SpB(SAVE_StkO);
802 P_ SuB = STKO_SuB(SAVE_StkO);
811 void printClosure PROTO( (P_, int, int) );
812 int numValues = size - vhs;
815 if (DEBUG_details > 1) {
816 printAddress( closure );
819 printName((P_)INFO_PTR(closure));
821 if ( numValues > 0 ) {
822 int newWeight = weight-1 ;
823 /* I've tried dividing the weight by size to share it out amongst
824 sub-closures - but that didn't work too well. */
829 while (i < numValues) {
830 P_ data = (P_) closure[_FHS + vhs + i];
832 printIndentation(indentation+1);
834 printClosure( data, indentation+1, newWeight);
836 printAddress( data );
839 if (i < numValues) printf(",\n");
845 for( i = 1; i < size; ++i ) {
853 /* Should be static but has to be extern to allow mutual recursion */
855 printClosure( P_ closure, int indentation, int weight )
860 /* I'd love to put a test here that this actually _is_ a closure -
861 but testing that it is in the heap is overly strong. */
863 getClosureShape(closure, &vhs, &size, &ptrs, &type);
865 /* The order here precisely reflects that in SMInfoTables.lh to make
866 it easier to check that this list is complete. */
867 switch(INFO_TYPE(INFO_PTR(closure))) {
868 case INFO_SPEC_U_TYPE:
869 case INFO_SPEC_N_TYPE:
870 case INFO_GEN_U_TYPE:
871 case INFO_GEN_N_TYPE:
873 case INFO_TUPLE_TYPE:
875 case INFO_MUTUPLE_TYPE:
876 case INFO_IMMUTUPLE_TYPE:
877 printStandardShapeClosure(indentation, weight, closure,
881 case INFO_STATIC_TYPE:
882 /* If the STATIC contains Floats or Doubles, we can't print it. */
883 /* And we can't always rely on the size/ptrs info either */
884 printAddress( closure );
888 case INFO_CONST_TYPE:
889 if (DEBUG_details > 1) {
890 printAddress( closure );
893 printName((P_)INFO_PTR(closure));
896 case INFO_CHARLIKE_TYPE:
897 /* ToDo: check for non-printable characters */
898 if (DEBUG_details > 1) printf("CHARLIKE ");
899 printf("\'%c\'", (unsigned char) CHARLIKE_VALUE(closure));
902 case INFO_INTLIKE_TYPE:
903 if (DEBUG_details > 1) printf("INTLIKE ");
904 printf("%ld",INTLIKE_VALUE(closure));
908 /* Is there anything to say here> */
909 if (DEBUG_details > 1) {
910 printAddress( closure );
913 printName((P_)INFO_PTR(closure));
916 /* most of the following are just plausible guesses (particularily VHSs) ADR */
920 printStandardShapeClosure(indentation, weight, closure,
923 printf("Panic: found BQ Infotable in non-threaded system.\n");
928 if (DEBUG_details > 0) {
929 printAddress( closure );
932 printClosure( (P_) IND_CLOSURE_PTR(closure), indentation, weight );
936 if (DEBUG_details > 0) {
937 printAddress( closure );
940 printClosure( (P_) IND_CLOSURE_PTR(closure), indentation, weight );
943 case INFO_FETCHME_TYPE:
945 printStandardShapeClosure(indentation, weight, closure,
948 printf("Panic: found FETCHME Infotable in sequential system.\n");
954 printStandardShapeClosure(indentation, weight, closure,
957 printf("Panic: found FMBQ Infotable in sequential system.\n");
963 printStandardShapeClosure(indentation, weight, closure,
966 printf("Panic: found BlockedFetch Infotable in sequential system.\n");
972 /* A TSO contains a regtable... */
973 printAddress( closure );
976 printf("Panic: found TSO Infotable in non-threaded system.\n");
982 /* A STKO contains parts of the A and B stacks... */
983 printAddress( closure );
984 printf(" STKO: ...");
986 printf("Panic: found STKO Infotable in non-threaded system.\n");
990 /* There are no others in SMInfoTables.lh 11/5/94 ADR*/
992 printf("Invalid/unknown info type %ld\n", INFO_TYPE(INFO_PTR(closure)));
998 DEBUG_NODE( P_ closure, int size )
1000 printClosure( closure, 0, size );
1005 Now some stuff for printing stacks - almost certainly doesn't work
1006 under threads which keep the stack on the heap.
1012 minimum(int a, int b)
1022 DEBUG_PrintA( int depth, int weight )
1028 I_ size = minimum(depth, SUBTRACT_A_STK(SpA, stackInfo.botA)+1);
1030 printf("Dump of the Address Stack (SpA = 0x%lx, SuA = 0x%lx)\n", SpA, SuA);
1032 for( i = 0; i < size; ++i ) {
1033 printIndentation(1);
1034 printf("SpA[%d] (0x%08lx):", i, SpA + AREL(i));
1035 printClosure((P_)*(SpA + AREL(i)), 2, weight);
1041 DEBUG_PrintB( int depth, int weight )
1048 I_ size = minimum(depth, SUBTRACT_B_STK(SpB, stackInfo.botB)+1);
1053 printf("Dump of the Value Stack (SpB = 0x%lx, SuB = 0x%lx)\n", SpB, SuB);
1055 updateFramePtr = SuB;
1059 if (updateFramePtr == SpB + BREL(i)) {
1061 printIndentation(1);
1062 printf("SpB[%ld] (0x%08lx): UpdateFrame[%d](",
1067 printName( (P_) *(SpB + BREL(i)) );
1068 printf(", UF[%d] (= SpB[%ld]), SpA[%ld], ",
1070 SUBTRACT_B_STK(SpB, GRAB_SuB(updateFramePtr)),
1071 SUBTRACT_A_STK(SpA, GRAB_SuA(updateFramePtr))
1073 printAddress( GRAB_UPDATEE(updateFramePtr) );
1076 printIndentation(2);
1077 printClosure( GRAB_UPDATEE(updateFramePtr), 3, weight );
1080 updateFramePtr = GRAB_SuB(updateFramePtr);
1081 update_count = update_count + 1;
1083 /* ToDo: GhcConstants.lh reveals that there are two other sizes possible */
1084 i = i + STD_UF_SIZE;
1086 printIndentation(1);
1087 printf("SpB[%ld] (0x%08lx): ", i, SpB + BREL(i) );
1088 printName((P_) *(SpB + BREL(i)) );
1095 #else /* CONCURRENT */
1098 minimum(int a, int b)
1108 DEBUG_PrintA( int depth, int weight )
1110 P_ stko = SAVE_StkO;
1111 PP_ SpA = STKO_SpA(stko);
1112 PP_ SuA = STKO_SuA(stko);
1113 P_ SpB = STKO_SpB(stko);
1114 P_ SuB = STKO_SuB(stko);
1118 I_ size = minimum(depth, SUBTRACT_A_STK(SpA, STKO_ASTK_BOT(stko))+1);
1120 printf("Dump of the Address Stack (SpA = 0x%x, SuA = 0x%x)\n", SpA, SuA);
1122 for( i = 0; i < size; ++i ) {
1123 printIndentation(1);
1124 printf("SpA[%ld] (0x%08lx):", i, SpA + AREL(i));
1125 printClosure((P_)*(SpA + AREL(i)), 2, weight);
1131 DEBUG_PrintB( int depth, int weight )
1133 P_ stko = SAVE_StkO;
1134 PP_ SpA = STKO_SpA(stko);
1135 PP_ SuA = STKO_SuA(stko);
1136 P_ SpB = STKO_SpB(stko);
1137 P_ SuB = STKO_SuB(stko);
1141 I_ size = minimum(depth, SUBTRACT_B_STK(SpB, STKO_BSTK_BOT(stko))+1);
1146 printf("Dump of the Value Stack (SpB = 0x%x, SuB = 0x%x)\n", SpB, SuB);
1148 updateFramePtr = SuB;
1152 if (updateFramePtr == SpB + BREL(i)) {
1154 printIndentation(1);
1155 printf("SpB[%ld] (0x%08lx): UpdateFrame[%d](",
1160 printName( (P_) *(SpB + BREL(i)) );
1161 printf(", UF[%d] (= SpB[%ld]), SpA[%ld], ",
1163 SUBTRACT_B_STK(SpB, GRAB_SuB(updateFramePtr)),
1164 SUBTRACT_A_STK(SpA, GRAB_SuA(updateFramePtr))
1166 printAddress( GRAB_UPDATEE(updateFramePtr) );
1169 printIndentation(2);
1170 printClosure( GRAB_UPDATEE(updateFramePtr), 3, weight );
1173 updateFramePtr = GRAB_SuB(updateFramePtr);
1174 update_count = update_count + 1;
1176 /* ToDo: GhcConstants.lh reveals that there are two other sizes possible */
1177 i = i + STD_UF_SIZE;
1179 printIndentation(1);
1180 printf("SpB[%ld] (0x%08lx): ", i, SpB + BREL(i) );
1181 printName((P_) *(SpB + BREL(i)) );
1188 #endif /* not CONCURRENT */
1193 All the following code incorrectly assumes that the only return
1194 addresses are those associated with update frames.
1196 To do a proper job of printing the environment we need to:
1198 1) Recognise vectored and non-vectored returns on the B stack.
1200 2) Know where the local variables are in the A and B stacks for
1201 each return situation.
1203 Until then, we'll just need to look suspiciously at the
1204 "environment" being printed out.
1209 /* How many real stacks are there on SpA and SpB? */
1210 /* Say what?? (Will and Phil, 96/01) */
1216 PP_ SpA = STKO_SpA(SAVE_StkO);
1217 PP_ SuA = STKO_SuA(SAVE_StkO);
1218 P_ SpB = STKO_SpB(SAVE_StkO);
1219 P_ SuB = STKO_SuB(SAVE_StkO);
1224 int depth = 1; /* There's always at least one stack */
1226 while (SUBTRACT_B_STK(SuB, stackInfo.botB) >= 0) {
1227 SuB = GRAB_SuB( SuB );
1232 #endif /* !CONCURRENT */
1235 printLocalAStack( int depth, int indentation, int weight, PP_ SpA, int size )
1239 ASSERT( size >= 0 );
1241 for( i = size-1; i >= 0; --i ) {
1242 printIndentation( indentation );
1243 printf("A[%ld][%d]", depth, i);
1244 if (DEBUG_details > 1) printf(" (0x%08lx) ", SpA + AREL(i) );
1246 printClosure( *(SpA + AREL(i)), indentation+2, weight );
1252 printLocalBStack( int depth, int indentation, int weight, P_ SpB, int size )
1256 ASSERT( size >= 0 );
1258 for( i = size-1; i >= 0; --i) {
1259 printIndentation( indentation );
1260 printf("B[%d][%d]", depth, i);
1261 if (DEBUG_details > 1) printf(" (0x%08lx) ", SpB + BREL(i) );
1263 printAddress( (P_) *(SpB + BREL(i)) );
1269 printEnvironment( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
1271 int sizeA = SUBTRACT_A_STK(SpA, SuA);
1272 int sizeB = SUBTRACT_B_STK(SpB, SuB);
1274 if (sizeA + sizeB > 0) {
1275 printIndentation( indentation );
1278 printLocalAStack( depth, indentation+1, weight, SpA, sizeA );
1279 printLocalBStack( depth, indentation+1, weight, SpB, sizeB );
1281 printIndentation( indentation );
1287 Printing the current context is a little tricky.
1289 Ideally, we would work from the bottom of the stack up to the top
1290 recursively printing the stuff nearer the top.
1292 In practice, we have to work from the top down because the top
1293 contains info about how much data is below the current return address.
1295 The result is that we have two recursive passes over the stacks: the
1296 first one prints the "cases" and the second one prints the
1297 continuations (vector tables, etc.)
1299 Note that because we compress chains of update frames, the depth and
1300 indentation do not always change in step.
1304 * detecting non-updating cases too
1305 * printing continuations (from vector tables) properly
1306 * printing sensible names in environment.
1307 * fix bogus nature of lets
1311 static int maxDepth = 5;
1314 printCases( int depth, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
1317 printf("no printCases for CONCURRENT\n");
1321 if (depth < maxDepth && SUBTRACT_B_STK(SuB, stackInfo.botB) >= 0) {
1322 PP_ nextSpA, nextSuA;
1323 P_ nextSpB, nextSuB;
1325 /* ToDo: GhcConstants.lh reveals that there are two other sizes of
1326 update frame possible */
1327 /* ToDo: botB is probably wrong in THREAD system */
1329 nextSpB = SuB + BREL(STD_UF_SIZE);
1330 nextSuB = GRAB_SuB( SuB );
1332 nextSuA = GRAB_SuA( nextSuB );
1334 indentation = printCases( depth+1, weight, nextSpA, nextSuA, nextSpB, nextSuB );
1336 if (DEBUG_details > 1 || nextSpB != nextSuB) { /* show frame (even if adjacent to another) */
1337 printIndentation( indentation );
1339 indentation = indentation + 1;
1342 /* next thing on stack is a return vector - no need to show it here. */
1343 SpB = SpB + BREL(1);
1345 printEnvironment( depth, indentation, weight, SpA, SuA, SpB, SuB );
1353 #endif /* CONCURRENT */
1356 /* ToDo: pay more attention to format of vector tables in SMupdate.lh */
1359 isVTBLEntry( P_ entry )
1363 if (lookupForName( entry, &raw )) {
1364 if ( strncmp( "_ret", raw, 4 ) == 0 ) {
1366 } else if ( strncmp( "_djn", raw, 4 ) == 0) {
1377 printVectorTable( int indentation, PP_ vtbl )
1379 if (isVTBLEntry( (P_) vtbl )) { /* Direct return */
1380 printName( (P_) vtbl );
1383 while( isVTBLEntry( vtbl[RVREL(i)] )) {
1384 printIndentation( indentation );
1385 printf( "%d -> ", i );
1386 printName( vtbl[RVREL(i)] );
1394 printContinuations( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB )
1397 printf("no printContinuations for CONCURRENT\n");
1399 if (depth < maxDepth && SUBTRACT_B_STK(SuB, stackInfo.botB) >= 0) {
1400 PP_ nextSpA, nextSuA;
1401 P_ nextSpB, nextSuB;
1402 int nextIndent = indentation; /* Indentation to print next frame at */
1404 /* ToDo: GhcConstants.lh reveals that there are two other sizes of
1405 update frame possible */
1406 /* ToDo: botB is probably wrong in THREAD system */
1408 /* ToDo: ASSERT that SuA == nextSuA */
1410 nextSpB = SuB + BREL(STD_UF_SIZE);
1411 nextSuB = GRAB_SuB( SuB );
1413 nextSuA = GRAB_SuA( nextSuB );
1415 if (DEBUG_details > 0) { /* print update information */
1417 if (SpB != SuB) { /* start of chain of update frames */
1418 printIndentation( indentation );
1419 printf("of updatePtr ->\n");
1420 printIndentation( indentation+1 );
1423 printIndentation( indentation+2 );
1424 printClosure( (P_)*(SuB + BREL(UF_UPDATEE)), indentation+2, weight );
1426 printName( (P_) *(SuB + BREL(UF_RET)) );
1427 printf("(updatePtr)\n");
1429 if (nextSpB != nextSuB) { /* end of chain of update frames */
1430 nextIndent = nextIndent-1;
1431 printVectorTable( indentation+1, (PP_) *(nextSpB) );
1434 if (nextSpB != nextSuB) { /* end of chain of update frames */
1435 nextIndent = nextIndent-1;
1436 printVectorTable( indentation, (PP_) *(nextSpB) );
1439 printContinuations( depth+1, nextIndent, weight, nextSpA, nextSuA, nextSpB, nextSuB );
1444 #endif /* CONCURRENT */
1448 DEBUG_Where( int depth, int weight )
1451 PP_ SpA = STKO_SpA(SAVE_StkO);
1452 PP_ SuA = STKO_SuA(SAVE_StkO);
1453 P_ SpB = STKO_SpB(SAVE_StkO);
1454 P_ SuB = STKO_SuB(SAVE_StkO);
1462 StgRetAddr RetReg = SAVE_Ret;
1463 P_ Node = SAVE_R1.p;
1469 printf("WARNING: Non-updating cases may be incorrectly displayed\n");
1471 indentation = printCases( 1, weight, SpA, SuA, SpB, SuB );
1473 printIndentation( indentation );
1476 printIndentation( indentation+1 );
1479 printVectorTable( indentation+1, (PP_) RetReg );
1481 printContinuations( depth, indentation, weight, SpA, SuA, SpB, SuB );
1488 DEBUG_INFO_TABLE(node)
1491 int vhs, size, ptrs; /* not used */
1493 StgPtr info_ptr = (StgPtr) INFO_PTR(node);
1495 getClosureShape(node, &vhs, &size, &ptrs, &ip_type);
1498 "%s Info Ptr 0x%lx; Entry: 0x%lx; Update: 0x%lx\n",
1500 (W_) ENTRY_CODE(info_ptr), (W_) UPDATE_CODE(info_ptr));
1502 "Tag: %ld; Type: %ld; Size: %lu; Ptrs: %lu\n\n",
1503 INFO_TAG(info_ptr), INFO_TYPE(info_ptr),
1504 INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
1506 /* flushing is GRIP only */
1507 fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
1510 #if defined(PROFILING)
1511 fprintf(stderr,"Cost Centre: 0x%lx\n",INFO_CAT(info_ptr));
1512 #endif /* PROFILING */
1514 #if defined(_INFO_COPYING)
1515 fprintf(stderr,"Evacuate Entry: 0x%lx;\tScavenge Entry: 0x%lx\n",
1516 INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
1517 #endif /* INFO_COPYING */
1519 #if defined(_INFO_COMPACTING)
1520 fprintf(stderr,"Scan Link: 0x%lx;\tScan Move: 0x%lx\n",
1521 (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
1522 fprintf(stderr,"Mark: 0x%lx;\tMarked: 0x%lx;\n",
1523 (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
1524 if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
1525 fprintf(stderr,"plus specialised code\n");
1527 fprintf(stderr,"Marking: 0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
1528 #endif /* INFO_COMPACTING */
1535 PP_ SpA = STKO_SpA(SAVE_StkO);
1536 PP_ SuA = STKO_SuA(SAVE_StkO);
1537 P_ SpB = STKO_SpB(SAVE_StkO);
1538 P_ SuB = STKO_SuB(SAVE_StkO);
1546 P_ HpLim= SAVE_HpLim;
1547 I_ TagReg= SAVE_Tag;
1548 StgRetAddr RetReg = SAVE_Ret;
1549 P_ Node = SAVE_R1.p;
1550 StgUnion R1 = SAVE_R1;
1551 StgUnion R2 = SAVE_R2;
1552 StgUnion R3 = SAVE_R3;
1553 StgUnion R4 = SAVE_R4;
1554 StgUnion R5 = SAVE_R5;
1555 StgUnion R6 = SAVE_R6;
1556 StgUnion R7 = SAVE_R7;
1557 StgUnion R8 = SAVE_R8;
1558 StgFloat FltReg1 = SAVE_Flt1;
1559 StgFloat FltReg2 = SAVE_Flt2;
1560 StgFloat FltReg3 = SAVE_Flt3;
1561 StgFloat FltReg4 = SAVE_Flt4;
1562 StgDouble DblReg1 = SAVE_Dbl1;
1563 StgDouble DblReg2 = SAVE_Dbl2;
1565 fprintf(stderr,"STG-Machine Register Values:\n\n");
1566 fprintf(stderr,"Node: %08lx; Hp: %08lx; HpLim: %08lx; Tag: %8lu\n",Node,(W_)Hp,(W_)HpLim,TagReg);
1567 fprintf(stderr,"SpA: %08lx; SpB: %08lx; SuA: %08lx; SuB: %08lx\n",(W_)SpA,(W_)SpB,(W_)SuA,(W_)SuB);
1568 fprintf(stderr,"RetReg: %08lx\n",RetReg);
1571 /* These bits need to have the FLUSH_REG_MAP, whereas the surrounding bits
1572 use the MAIN_REG_MAP */
1574 fprintf(stderr, "\n");
1575 fprintf(stderr,"LiveR: %08lx\n", LivenessReg);
1576 fprintf(stderr,"Flush: %08lx; FStk: %08lx; FStkB: %08lx; FTmp: %08lx\n",(W_)FlushP,(W_)FStack,(W_)FStackBase,(W_)Temp);
1579 fprintf(stderr, "\n");
1581 fprintf(stderr,"Gen: %8lu, %8lu, %8lu, %8lu\n",R1.i,R2.i,R3.i,R4.i);
1582 fprintf(stderr," %8lu, %8lu, %8lu, %8lu\n",R5.i,R6.i,R7.i,R8.i);
1583 fprintf(stderr,"Float: %8g, %8g, %8g, %8g\n",FltReg1,FltReg2,FltReg3,FltReg4);
1584 fprintf(stderr,"Dble: %8g, %8g\n",DblReg1,DblReg2);
1595 fprintf(stderr,"ForeignObjList\n\n");
1597 for(mp = StorageMgrInfo.ForeignObjList;
1599 mp = ForeignObj_CLOSURE_LINK(mp)) {
1602 "ForeignObjPtr(0x%lx) = 0x%lx, finaliser: 0x%lx\n",
1604 ForeignObj_CLOSURE_DATA(mp),
1605 ForeignObj_CLOSURE_FINALISER(mp));
1608 DEBUG_PRINT_NODE(mp);
1612 # if defined(GCap) || defined(GCgn)
1613 fprintf(stderr,"\nOldForeignObj List\n\n");
1615 for(mp = StorageMgrInfo.OldForeignObjList;
1617 mp = ForeignObj_CLOSURE_LINK(mp)) {
1620 "ForeignObj(0x%lx) = 0x%lx, finaliser: 0x%lx\n",
1622 ForeignObj_CLOSURE_DATA(mp),
1623 ForeignObj_CLOSURE_FINALISER(mp));
1625 DEBUG_PRINT_NODE(mp);
1628 # endif /* GCap || GCgn */
1630 fprintf(stderr, "\n");
1634 DEBUG_SPT(int weight)
1636 StgPtr SPTable = StorageMgrInfo.StablePointerTable;
1637 StgInt size = SPT_SIZE(SPTable);
1638 StgInt ptrs = SPT_NoPTRS(SPTable);
1639 StgInt top = SPT_TOP(SPTable);
1644 DEBUG_PRINT_NODE(SPTable);
1647 fprintf(stderr,"SPTable@0x%lx:\n", SPTable);
1648 fprintf(stderr," InfoPtr = 0x%lx\n", INFO_PTR(SPTable));
1649 fprintf(stderr," size = %d, ptrs = %d, top = %d\n",
1652 for( i=0; i < ptrs; i++ ) {
1654 fprintf(stderr,"\n ");
1656 printClosure(SPT_SPTR(SPTable, i),1,weight);
1657 fprintf(stderr, "\n");
1659 fprintf(stderr, "\n");
1660 for( i=0; i < top; i++) {
1662 fprintf(stderr,"\n ");
1664 fprintf(stderr, " %3d", SPT_FREE(SPTable, i));
1667 fprintf(stderr, "\n\n");
1670 #endif /* !CONCURRENT */
1673 These routines crawl over the A and B stacks, printing
1674 a maximum "lines" lines at the top of the stack.
1677 #define STACK_VALUES_PER_LINE 5
1680 /* (stack stuff is really different on parallel machines) */
1694 fprintf(stderr,"Dump of the Address Stack, SpA: 0x%08lx, BOS: 0x%08lx\n",
1695 (W_) SpA, (W_) stackInfo.botA);
1697 for (stackptr = SpA;
1698 SUBTRACT_A_STK(stackptr, stackInfo.botA) >= 0;
1699 stackptr = stackptr + AREL(1))
1701 if( count++ % STACK_VALUES_PER_LINE == 0)
1703 if(count >= lines * STACK_VALUES_PER_LINE)
1705 fprintf(stderr,"\nSpA[%ld] (0x%08lx): ",count-1,stackptr);
1707 fprintf(stderr,"0x%08lx ",(W_) *stackptr);
1709 fprintf(stderr, "\n");
1724 fprintf(stderr,"Dump of the Value Stack, SpB: 0x%08lx, BOS: 0x%08lx\n",
1725 (W_) SpB, (W_) stackInfo.botB);
1727 for (stackptr = SpB;
1728 SUBTRACT_B_STK(stackptr, stackInfo.botB) > 0;
1729 stackptr = stackptr + BREL(1))
1731 if( count++ % STACK_VALUES_PER_LINE == 0)
1733 if(count >= lines * STACK_VALUES_PER_LINE)
1735 fprintf(stderr,"\nSpB[%ld] (0x%08lx): ",count-1,stackptr);
1737 fprintf(stderr,"0x%08lx ",(W_) *stackptr);
1739 fprintf(stderr, "\n");
1743 #endif /* not concurrent */
1746 This should disentangle update frames from both stacks.
1751 DEBUG_UPDATES(limit)
1764 fprintf(stderr,"Update Frame Stack Dump:\n\n");
1766 for(spa = SuA, spb = SuB;
1767 SUBTRACT_B_STK(spb, stackInfo.botB) > 0 && count++ < limit;
1768 spa = GRAB_SuA(spb), spb = GRAB_SuB(spb) ) {
1770 updatee = GRAB_UPDATEE(spb); /* Thing to be updated */
1771 retreg = (P_) GRAB_RET(spb); /* Return vector below */
1773 fprintf(stderr,"SuA: 0x%08lx, SuB: 0x%08lx, Updatee 0x%08lx (Info 0x%08lx), RetReg 0x%x\n",
1775 (W_) updatee, (W_) INFO_PTR(updatee), (W_) retreg);
1779 #endif /* not concurrent */
1788 STGRegisterTable *r = TSO_INTERNAL_PTR(tso);
1789 W_ liveness = r->rLiveness;
1792 fprintf(stderr,"TSO:\ntso=%lx, regs=%lx, liveness=%lx\nlink=%lx,name=%lx,id=%lx,type=%lx,pc1=%lx,arg1=%lx,switch=%lx\n"
1805 for (i = 0; liveness != 0; liveness >>= 1, i++) {
1807 fprintf(stderr, "live reg %d (%lx)\n",i, r->rR[i].p);
1809 fprintf(stderr, "reg %d (%lx) not live\n", i, r->rR[i].p);
1814 #endif /* concurrent */
1817 %****************************************************************************
1819 \subsection[GrAnSim-debug]{Debugging routines for GrAnSim}
1821 %****************************************************************************
1823 Debugging routines, mainly for GrAnSim.
1824 They should really be in a separate file.
1825 There is some code duplication of above routines in here, I'm afraid.
1827 As a naming convention all GrAnSim debugging functions start with @G_@.
1828 The shorthand forms defined at the end start only with @G@.
1831 #if defined(GRAN) && defined(GRAN_CHECK)
1833 #define NULL_REG_MAP /* Not threaded */
1834 /* #include "stgdefs.h" */
1837 info_hdr_type(info_ptr)
1840 #if ! defined(PAR) && !defined(GRAN)
1841 switch (INFO_TAG(info_ptr))
1843 case INFO_OTHER_TAG:
1844 return("OTHER_TAG");
1845 /* case INFO_IND_TAG:
1851 switch(BASE_INFO_TYPE(info_ptr))
1853 case INFO_SPEC_TYPE:
1862 case INFO_TUPLE_TYPE:
1865 case INFO_DATA_TYPE:
1868 case INFO_MUTUPLE_TYPE:
1871 case INFO_IMMUTUPLE_TYPE:
1872 return("IMMUTUPLE");
1874 case INFO_STATIC_TYPE:
1877 case INFO_CONST_TYPE:
1880 case INFO_CHARLIKE_TYPE:
1883 case INFO_INTLIKE_TYPE:
1904 case INFO_STKO_TYPE:
1907 case INFO_SPEC_RBH_TYPE:
1910 case INFO_GEN_RBH_TYPE:
1916 case INFO_INTERNAL_TYPE:
1920 fprintf(stderr,"Unknown header type %lu\n",INFO_TYPE(info_ptr));
1927 info_type(infoptr, str)
1932 if ( IS_NF(infoptr) )
1933 strcat(str,"|_NF ");
1934 else if ( IS_MUTABLE(infoptr) )
1936 else if ( IS_STATIC(infoptr) )
1938 else if ( IS_UPDATABLE(infoptr) )
1940 else if ( IS_BIG_MOTHER(infoptr) )
1942 else if ( IS_BLACK_HOLE(infoptr) )
1944 else if ( IS_INDIRECTION(infoptr) )
1946 else if ( IS_THUNK(infoptr) )
1953 @var_hdr_size@ computes the size of the variable header for a closure.
1960 switch(INFO_TYPE(INFO_PTR(node)))
1962 case INFO_SPEC_U_TYPE: return(0); /* by decree */
1963 case INFO_SPEC_N_TYPE: return(0);
1964 case INFO_GEN_U_TYPE: return(GEN_VHS);
1965 case INFO_GEN_N_TYPE: return(GEN_VHS);
1966 case INFO_DYN_TYPE: return(DYN_VHS);
1968 case INFO_DYN_TYPE_N: return(DYN_VHS);
1969 case INFO_DYN_TYPE_U: return(DYN_VHS);
1971 case INFO_TUPLE_TYPE: return(TUPLE_VHS);
1972 case INFO_DATA_TYPE: return(DATA_VHS);
1973 case INFO_MUTUPLE_TYPE: return(MUTUPLE_VHS);
1974 case INFO_IMMUTUPLE_TYPE: return(MUTUPLE_VHS); /* same layout */
1975 case INFO_STATIC_TYPE: return(STATIC_VHS);
1976 case INFO_CONST_TYPE: return(0);
1977 case INFO_CHARLIKE_TYPE: return(0);
1978 case INFO_INTLIKE_TYPE: return(0);
1979 case INFO_BH_TYPE: return(0);
1980 case INFO_IND_TYPE: return(0);
1981 case INFO_CAF_TYPE: return(0);
1982 case INFO_FETCHME_TYPE: return(0);
1983 case INFO_BQ_TYPE: return(0);
1985 case INFO_BQENT_TYPE: return(0);
1987 case INFO_TSO_TYPE: return(TSO_VHS);
1988 case INFO_STKO_TYPE: return(STKO_VHS);
1990 fprintf(stderr,"Unknown info type 0x%lx (%lu)\n", INFO_PTR(node),
1991 INFO_TYPE(INFO_PTR(node)));
1997 /* Determine the size and number of pointers for this kind of closure */
1999 size_and_ptrs(node,size,ptrs)
2003 switch(INFO_TYPE(INFO_PTR(node)))
2005 case INFO_SPEC_U_TYPE:
2006 case INFO_SPEC_N_TYPE:
2007 *size = INFO_SIZE(INFO_PTR(node)); /* New for 0.24; check */
2008 *ptrs = INFO_NoPTRS(INFO_PTR(node)); /* that! -- HWL */
2010 *size = SPEC_CLOSURE_SIZE(node);
2011 *ptrs = SPEC_CLOSURE_NoPTRS(node);
2015 case INFO_GEN_U_TYPE:
2016 case INFO_GEN_N_TYPE:
2017 *size = GEN_CLOSURE_SIZE(node);
2018 *ptrs = GEN_CLOSURE_NoPTRS(node);
2022 case INFO_DYN_TYPE_U:
2023 case INFO_DYN_TYPE_N:
2026 *size = DYN_CLOSURE_SIZE(node);
2027 *ptrs = DYN_CLOSURE_NoPTRS(node);
2030 case INFO_TUPLE_TYPE:
2031 *size = TUPLE_CLOSURE_SIZE(node);
2032 *ptrs = TUPLE_CLOSURE_NoPTRS(node);
2035 case INFO_DATA_TYPE:
2036 *size = DATA_CLOSURE_SIZE(node);
2037 *ptrs = DATA_CLOSURE_NoPTRS(node);
2041 *size = IND_CLOSURE_SIZE(node);
2042 *ptrs = IND_CLOSURE_NoPTRS(node);
2045 /* ToDo: more (WDP) */
2047 /* Don't know about the others */
2058 P_ info_ptr, bqe; /* = INFO_PTR(node); */
2059 I_ size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0;
2060 char info_hdr_ty[80], info_ty[80];
2063 fprintf(stderr,"NULL\n");
2065 } else if (node==Prelude_Z91Z93_closure) {
2066 fprintf(stderr,"Prelude_Z91Z93_closure\n");
2068 } else if (node==MUT_NOT_LINKED) {
2069 fprintf(stderr,"MUT_NOT_LINKED\n");
2072 /* size_and_ptrs(node,&size,&ptrs); */
2073 info_ptr = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_hdr_ty);
2075 /* vhs = var_hdr_size(node); */
2076 info_type(info_ptr,info_ty);
2078 fprintf(stderr,"Node: 0x%lx", (W_) node);
2081 fprintf(stderr," [GA: 0x%lx]",GA(node));
2084 #if defined(USE_COST_CENTRES)
2085 fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
2089 fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
2092 if (info_ptr==INFO_TSO_TYPE)
2093 fprintf(stderr," TSO: 0x%lx (%x) IP: 0x%lx (%s), type %s \n ",
2094 node, TSO_ID(node), info_ptr, info_hdr_ty, info_ty);
2096 fprintf(stderr," IP: 0x%lx (%s), type %s \n VHS: %d, size: %ld, ptrs:%ld, nonptrs: %ld\n ",
2097 info_ptr,info_hdr_ty,info_ty,vhs,size,ptrs,nonptrs);
2099 /* For now, we ignore the variable header */
2101 fprintf(stderr," Ptrs: ");
2102 for(i=0; i < ptrs; ++i)
2104 if ( (i+1) % 6 == 0)
2105 fprintf(stderr,"\n ");
2106 fprintf(stderr," 0x%lx[P]",*(node+_FHS+vhs+i));
2109 fprintf(stderr," Data: ");
2110 for(i=0; i < nonptrs; ++i)
2113 fprintf(stderr,"\n ");
2114 fprintf(stderr," %lu[D]",*(node+_FHS+vhs+ptrs+i));
2116 fprintf(stderr, "\n");
2119 switch (INFO_TYPE(info_ptr))
2122 fprintf(stderr,"\n TSO_LINK: %#lx",
2128 bqe = (P_)BQ_ENTRIES(node);
2129 fprintf(stderr," BQ of %#lx: ", node);
2132 case INFO_FMBQ_TYPE:
2133 printf("Panic: found FMBQ Infotable in GrAnSim system.\n");
2135 case INFO_SPEC_RBH_TYPE:
2136 bqe = (P_)SPEC_RBH_BQ(node);
2137 fprintf(stderr," BQ of %#lx: ", node);
2140 case INFO_GEN_RBH_TYPE:
2141 bqe = (P_)GEN_RBH_BQ(node);
2142 fprintf(stderr," BQ of %#lx: ", node);
2149 G_PPN(node) /* Extracted from PrintPacket in Pack.lc */
2153 I_ size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0, locn = 0;
2156 /* size_and_ptrs(node,&size,&ptrs); */
2157 info = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_type);
2159 if (INFO_TYPE(info) == INFO_FETCHME_TYPE || IS_BLACK_HOLE(info))
2160 size = ptrs = nonptrs = vhs = 0;
2162 if (IS_THUNK(info)) {
2163 if (IS_UPDATABLE(info))
2164 fputs("SHARED ", stderr);
2166 fputs("UNSHARED ", stderr);
2168 if (IS_BLACK_HOLE(info)) {
2169 fputs("BLACK HOLE\n", stderr);
2172 fprintf(stderr, "(%s) FH [%#lx", info_type, node[locn++]);
2173 for (i = 1; i < FIXED_HS; i++)
2174 fprintf(stderr, " %#lx", node[locn++]);
2176 /* Variable header */
2178 fprintf(stderr, "] VH [%#lx", node[locn++]);
2180 for (i = 1; i < vhs; i++)
2181 fprintf(stderr, " %#lx", node[locn++]);
2184 fprintf(stderr, "] PTRS %u", ptrs);
2188 fprintf(stderr, " NPTRS [%#lx", node[locn++]);
2190 for (i = 1; i < nonptrs; i++)
2191 fprintf(stderr, " %#lx", node[locn++]);
2200 #define INFO_MASK 0x80000000
2203 G_MUT(node,verbose) /* Print mutables list starting with node */
2206 if (verbose & 0x1) { G_PRINT_NODE(node); fprintf(stderr, "\n"); }
2207 else fprintf(stderr, "0x%#lx, ", node);
2209 if (node==NULL || node==Prelude_Z91Z93_closure || node==MUT_NOT_LINKED) {
2212 G_MUT(MUT_LINK(node), verbose);
2220 W_ size = 0, ptrs = 0, i, vhs = 0;
2222 /* Don't print cycles */
2223 if((INFO_PTR(node) & INFO_MASK) != 0)
2226 size_and_ptrs(node,&size,&ptrs);
2227 vhs = var_hdr_size(node);
2230 fprintf(stderr, "\n");
2232 /* Mark the node -- may be dangerous */
2233 INFO_PTR(node) |= INFO_MASK;
2235 for(i = 0; i < ptrs; ++i)
2236 G_TREE((P_)node[i+vhs+_FHS]);
2238 /* Unmark the node */
2239 INFO_PTR(node) &= ~INFO_MASK;
2247 P_ info_ptr = (P_)INFO_PTR(node);
2248 char *ip_type = info_hdr_type(info_ptr);
2250 fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
2251 ip_type,info_ptr,(W_) ENTRY_CODE(info_ptr),INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
2253 if (IS_THUNK(info_ptr) && IS_UPDATABLE(info_ptr) ) {
2254 fprintf(stderr," RBH InfoPtr: %#lx\n",
2255 RBH_INFOPTR(info_ptr));
2259 fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
2262 #if defined(USE_COST_CENTRES)
2263 fprintf(stderr,"Cost Centre (???): 0x%lx\n",INFO_CAT(info_ptr));
2266 #if defined(_INFO_COPYING)
2267 fprintf(stderr,"Evacuate Entry: 0x%lx;\tScavenge Entry: 0x%lx\n",
2268 INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
2271 #if defined(_INFO_COMPACTING)
2272 fprintf(stderr,"Scan Link: 0x%lx;\tScan Move: 0x%lx\n",
2273 (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
2274 fprintf(stderr,"Mark: 0x%lx;\tMarked: 0x%lx;\t",
2275 (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
2276 #if 0 /* avoid INFO_TYPE */
2277 if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
2278 fprintf(stderr,"plus specialised code\n");
2280 fprintf(stderr,"Marking: 0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
2282 #endif /* _INFO_COMPACTING */
2288 The remaining debugging routines are more or less specific for GrAnSim.
2291 #if defined(GRAN) && defined(GRAN_CHECK)
2293 G_CURR_THREADQ(verbose)
2296 fprintf(stderr,"Thread Queue on proc %d: ", CurrentProc);
2297 G_THREADQ(ThreadQueueHd, verbose);
2301 G_THREADQ(closure, verbose)
2307 fprintf(stderr,"Thread Queue: ");
2308 for (x=closure; x!=Prelude_Z91Z93_closure; x=TSO_LINK(x))
2312 fprintf(stderr," %#lx",x);
2314 if (closure==Prelude_Z91Z93_closure)
2315 fprintf(stderr,"NIL\n");
2317 fprintf(stderr,"\n");
2320 /* Check with Threads.lh */
2321 static char *type_name[] = { "T_MAIN", "T_REQUIRED", "T_ADVISORY", "T_FAIL"};
2324 G_TSO(closure,verbose)
2329 if (closure==Prelude_Z91Z93_closure) {
2330 fprintf(stderr,"TSO at %#lx is Prelude_Z91Z93_closure!\n");
2334 if ( verbose & 0x08 ) { /* short info */
2335 fprintf(stderr,"[TSO @ %#lx, PE %d]: Name: %#lx, Id: %#lx, Link: %#lx\n",
2336 closure,where_is(closure),
2337 TSO_NAME(closure),TSO_ID(closure),TSO_LINK(closure));
2341 fprintf(stderr,"TSO at %#lx has the following contents:\n",
2344 fprintf(stderr,"> Name: \t%#lx",TSO_NAME(closure));
2345 fprintf(stderr,"\tLink: \t%#lx\n",TSO_LINK(closure));
2346 fprintf(stderr,"> Id: \t%#lx",TSO_ID(closure));
2347 #if defined(GRAN_CHECK) && defined(GRAN)
2348 if (RTSflags.GranFlags.debug & 0x10)
2349 fprintf(stderr,"\tType: \t%s %s\n",
2350 type_name[TSO_TYPE(closure) & ~FETCH_MASK_TSO],
2351 (TSO_TYPE(closure) & FETCH_MASK_TSO) ? "SLEEPING" : "");
2353 fprintf(stderr,"\tType: \t%s\n",type_name[TSO_TYPE(closure)]);
2355 fprintf(stderr,"\tType: \t%s\n",type_name[TSO_TYPE(closure)]);
2357 fprintf(stderr,"> PC1: \t%#lx",TSO_PC1(closure));
2358 fprintf(stderr,"\tPC2: \t%#lx\n",TSO_PC2(closure));
2359 fprintf(stderr,"> ARG1: \t%#lx",TSO_ARG1(closure));
2360 /* fprintf(stderr,"\tARG2: \t%#lx\n",TSO_ARG2(closure)); */
2361 fprintf(stderr,"> SWITCH: \t%#lx", TSO_SWITCH(closure));
2362 #if defined(GRAN_PRI_SCHED)
2363 fprintf(stderr,"\tPRI: \t%#lx\n", TSO_PRI(closure));
2365 fprintf(stderr,"\n");
2368 fprintf(stderr,"} LOCKED: \t%#lx",TSO_LOCKED(closure));
2369 fprintf(stderr,"\tSPARKNAME: \t%#lx\n", TSO_SPARKNAME(closure));
2370 fprintf(stderr,"} STARTEDAT: \t%#lx", TSO_STARTEDAT(closure));
2371 fprintf(stderr,"\tEXPORTED: \t%#lx\n", TSO_EXPORTED(closure));
2372 fprintf(stderr,"} BASICBLOCKS: \t%#lx", TSO_BASICBLOCKS(closure));
2373 fprintf(stderr,"\tALLOCS: \t%#lx\n", TSO_ALLOCS(closure));
2374 fprintf(stderr,"} EXECTIME: \t%#lx", TSO_EXECTIME(closure));
2375 fprintf(stderr,"\tFETCHTIME: \t%#lx\n", TSO_FETCHTIME(closure));
2376 fprintf(stderr,"} FETCHCOUNT: \t%#lx", TSO_FETCHCOUNT(closure));
2377 fprintf(stderr,"\tBLOCKTIME: \t%#lx\n", TSO_BLOCKTIME(closure));
2378 fprintf(stderr,"} BLOCKCOUNT: \t%#lx", TSO_BLOCKCOUNT(closure));
2379 fprintf(stderr,"\tBLOCKEDAT: \t%#lx\n", TSO_BLOCKEDAT(closure));
2380 fprintf(stderr,"} GLOBALSPARKS:\t%#lx", TSO_GLOBALSPARKS(closure));
2381 fprintf(stderr,"\tLOCALSPARKS:\t%#lx\n", TSO_LOCALSPARKS(closure));
2383 #if defined(GRAN_CHECK)
2384 if ( verbose & 0x02 ) {
2385 fprintf(stderr,"BQ that starts with this TSO: ");
2392 G_EVENT(event, verbose)
2399 fprintf(stderr," %#lx",event);
2409 fprintf(stderr,"Eventq (hd @%#lx):\n",EventHd);
2410 for (x=EventHd; x!=NULL; x=EVENT_NEXT(x)) {
2414 fprintf(stderr,"NIL\n");
2416 fprintf(stderr,"\n");
2426 fprintf(stderr,"Eventq (hd @%#lx):\n",EventHd);
2427 for (x=EventHd; x!=NULL; x=EVENT_NEXT(x)) {
2428 if (EVENT_PROC(x)==pe)
2432 fprintf(stderr,"NIL\n");
2434 fprintf(stderr,"\n");
2438 G_SPARK(spark, verbose)
2445 fprintf(stderr," %#lx",spark);
2449 G_SPARKQ(spark,verbose)
2455 fprintf(stderr,"Sparkq (hd @%#lx):\n",spark);
2456 for (x=spark; x!=NULL; x=SPARK_NEXT(x)) {
2460 fprintf(stderr,"NIL\n");
2462 fprintf(stderr,"\n");
2466 G_CURR_SPARKQ(verbose)
2469 G_SPARKQ(SparkQueueHd,verbose);
2473 G_PROC(proc,verbose)
2477 extern char *proc_status_names[];
2479 fprintf(stderr,"Status of proc %d at time %d (%#lx): %s (%s)\n",
2480 proc,CurrentTime[proc],CurrentTime[proc],
2481 (CurrentProc==proc)?"ACTIVE":"INACTIVE",
2482 proc_status_names[procStatus[proc]]);
2483 G_THREADQ(RunnableThreadsHd[proc],verbose & 0x2);
2484 if ( (CurrentProc==proc) )
2485 G_TSO(CurrentTSO,1);
2488 fprintf(stderr,"Next event (%s) is on proc %d\n",
2489 event_names[EVENT_TYPE(EventHd)],EVENT_PROC(EventHd));
2491 if (verbose & 0x1) {
2492 fprintf(stderr,"\nREQUIRED sparks: ");
2493 G_SPARKQ(PendingSparksHd[proc][REQUIRED_POOL],1);
2494 fprintf(stderr,"\nADVISORY_sparks: ");
2495 G_SPARKQ(PendingSparksHd[proc][ADVISORY_POOL],1);
2499 /* Debug Processor */
2506 /* Debug Current Processor */
2508 GCP(){ G_PROC(CurrentProc,2); }
2516 /* Debug CurrentTSO */
2519 fprintf(stderr,"Current Proc: %d\n",CurrentProc);
2520 G_TSO(CurrentTSO,1);
2523 /* Shorthand for debugging event queue */
2525 GEQ() { G_EVENTQ(1); }
2527 /* Shorthand for debugging thread queue of a processor */
2529 GTQ(PROC p) { G_THREADQ(RunnableThreadsHd[p],1); }
2531 /* Shorthand for debugging thread queue of current processor */
2533 GCTQ() { G_THREADQ(RunnableThreadsHd[CurrentProc],1); }
2535 /* Shorthand for debugging spark queue of a processor */
2537 GSQ(PROC p) { G_SPARKQ(PendingSparksHd[p][1],1); }
2539 /* Shorthand for debugging spark queue of current processor */
2541 GCSQ() { G_CURR_SPARKQ(1); }
2543 /* Shorthand for printing a node */
2545 GN(P_ node) { G_PRINT_NODE(node); }
2547 /* Shorthand for printing info table */
2549 GIT(P_ node) { G_INFO_TABLE(node); }
2551 /* Shorthand for some of ADRs debugging functions */
2554 pC(P_ closure) { printClosure(closure, 0/*indentation*/, 10/*weight*/); }
2556 /* Print a closure on the heap */
2558 DN(P_ closure) { DEBUG_NODE( closure, 1/*size*/ );}
2560 /* Print info-table of a closure */
2562 DIT(P_ closure) { DEBUG_INFO_TABLE(closure); }
2564 /* (CONCURRENT) Print a Thread State Object */
2566 DT(P_ tso) { DEBUG_TSO(tso); }
2568 /* Not yet implemented: */
2569 /* (CONCURRENT) Print a STacK Object
2571 DS(P_ stko) { DEBUG_STKO(stko) ; }
2576 /* --------------------------- vvvv old vvvvv ------------------------*/
2578 #if 0 /* ngo' ngoq! veQ yIboS! */
2580 #define NULL_REG_MAP /* Not threaded */
2581 #include "stgdefs.h"
2584 info_hdr_type(info_ptr)
2587 #if ! defined(PAR) && !defined(GRAN)
2588 switch (INFO_TAG(info_ptr))
2590 case INFO_OTHER_TAG:
2591 return("OTHER_TAG");
2592 /* case INFO_IND_TAG:
2598 switch(INFO_TYPE(info_ptr))
2600 case INFO_SPEC_U_TYPE:
2603 case INFO_SPEC_N_TYPE:
2606 case INFO_GEN_U_TYPE:
2609 case INFO_GEN_N_TYPE:
2616 case INFO_DYN_TYPE_N:
2619 case INFO_DYN_TYPE_U:
2623 case INFO_TUPLE_TYPE:
2626 case INFO_DATA_TYPE:
2629 case INFO_MUTUPLE_TYPE:
2632 case INFO_IMMUTUPLE_TYPE:
2633 return("IMMUTUPLE");
2635 case INFO_STATIC_TYPE:
2638 case INFO_CONST_TYPE:
2641 case INFO_CHARLIKE_TYPE:
2644 case INFO_INTLIKE_TYPE:
2656 case INFO_FETCHME_TYPE:
2663 case INFO_BQENT_TYPE:
2670 case INFO_STKO_TYPE:
2674 fprintf(stderr,"Unknown header type %lu\n",INFO_TYPE(info_ptr));
2681 @var_hdr_size@ computes the size of the variable header for a closure.
2688 switch(INFO_TYPE(INFO_PTR(node)))
2690 case INFO_SPEC_U_TYPE: return(0); /* by decree */
2691 case INFO_SPEC_N_TYPE: return(0);
2692 case INFO_GEN_U_TYPE: return(GEN_VHS);
2693 case INFO_GEN_N_TYPE: return(GEN_VHS);
2694 case INFO_DYN_TYPE: return(DYN_VHS);
2696 case INFO_DYN_TYPE_N: return(DYN_VHS);
2697 case INFO_DYN_TYPE_U: return(DYN_VHS);
2699 case INFO_TUPLE_TYPE: return(TUPLE_VHS);
2700 case INFO_DATA_TYPE: return(DATA_VHS);
2701 case INFO_MUTUPLE_TYPE: return(MUTUPLE_VHS);
2702 case INFO_IMMUTUPLE_TYPE: return(MUTUPLE_VHS); /* same layout */
2703 case INFO_STATIC_TYPE: return(STATIC_VHS);
2704 case INFO_CONST_TYPE: return(0);
2705 case INFO_CHARLIKE_TYPE: return(0);
2706 case INFO_INTLIKE_TYPE: return(0);
2707 case INFO_BH_TYPE: return(0);
2708 case INFO_IND_TYPE: return(0);
2709 case INFO_CAF_TYPE: return(0);
2710 case INFO_FETCHME_TYPE: return(0);
2711 case INFO_BQ_TYPE: return(0);
2713 case INFO_BQENT_TYPE: return(0);
2715 case INFO_TSO_TYPE: return(TSO_VHS);
2716 case INFO_STKO_TYPE: return(STKO_VHS);
2718 fprintf(stderr,"Unknown info type 0x%lx (%lu)\n", INFO_PTR(node),
2719 INFO_TYPE(INFO_PTR(node)));
2725 /* Determine the size and number of pointers for this kind of closure */
2727 size_and_ptrs(node,size,ptrs)
2731 switch(INFO_TYPE(INFO_PTR(node)))
2733 case INFO_SPEC_U_TYPE:
2734 case INFO_SPEC_N_TYPE:
2735 *size = INFO_SIZE(INFO_PTR(node)); /* New for 0.24; check */
2736 *ptrs = INFO_NoPTRS(INFO_PTR(node)); /* that! -- HWL */
2738 *size = SPEC_CLOSURE_SIZE(node);
2739 *ptrs = SPEC_CLOSURE_NoPTRS(node);
2743 case INFO_GEN_U_TYPE:
2744 case INFO_GEN_N_TYPE:
2745 *size = GEN_CLOSURE_SIZE(node);
2746 *ptrs = GEN_CLOSURE_NoPTRS(node);
2750 case INFO_DYN_TYPE_U:
2751 case INFO_DYN_TYPE_N:
2754 *size = DYN_CLOSURE_SIZE(node);
2755 *ptrs = DYN_CLOSURE_NoPTRS(node);
2758 case INFO_TUPLE_TYPE:
2759 *size = TUPLE_CLOSURE_SIZE(node);
2760 *ptrs = TUPLE_CLOSURE_NoPTRS(node);
2763 case INFO_DATA_TYPE:
2764 *size = DATA_CLOSURE_SIZE(node);
2765 *ptrs = DATA_CLOSURE_NoPTRS(node);
2769 *size = IND_CLOSURE_SIZE(node);
2770 *ptrs = IND_CLOSURE_NoPTRS(node);
2773 /* ToDo: more (WDP) */
2775 /* Don't know about the others */
2783 DEBUG_PRINT_NODE(node)
2786 W_ info_ptr = INFO_PTR(node);
2787 I_ size = 0, ptrs = 0, i, vhs = 0;
2788 char *info_type = info_hdr_type(info_ptr);
2790 size_and_ptrs(node,&size,&ptrs);
2791 vhs = var_hdr_size(node);
2793 fprintf(stderr,"Node: 0x%lx", (W_) node);
2796 fprintf(stderr," [GA: 0x%lx]",GA(node));
2799 #if defined(PROFILING)
2800 fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
2804 fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
2807 fprintf(stderr," IP: 0x%lx (%s), size %ld, %ld ptrs\n",
2808 info_ptr,info_type,size,ptrs);
2810 /* For now, we ignore the variable header */
2812 for(i=0; i < size; ++i)
2815 fprintf(stderr,"Data: ");
2818 fprintf(stderr,"\n ");
2821 fprintf(stderr," 0x%lx[P]",*(node+_FHS+vhs+i));
2823 fprintf(stderr," %lu[D]",*(node+_FHS+vhs+i));
2825 fprintf(stderr, "\n");
2829 #define INFO_MASK 0x80000000
2835 W_ size = 0, ptrs = 0, i, vhs = 0;
2837 /* Don't print cycles */
2838 if((INFO_PTR(node) & INFO_MASK) != 0)
2841 size_and_ptrs(node,&size,&ptrs);
2842 vhs = var_hdr_size(node);
2844 DEBUG_PRINT_NODE(node);
2845 fprintf(stderr, "\n");
2847 /* Mark the node -- may be dangerous */
2848 INFO_PTR(node) |= INFO_MASK;
2850 for(i = 0; i < ptrs; ++i)
2851 DEBUG_TREE((P_)node[i+vhs+_FHS]);
2853 /* Unmark the node */
2854 INFO_PTR(node) &= ~INFO_MASK;
2859 DEBUG_INFO_TABLE(node)
2862 W_ info_ptr = INFO_PTR(node);
2863 char *ip_type = info_hdr_type(info_ptr);
2865 fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
2866 ip_type,info_ptr,(W_) ENTRY_CODE(info_ptr),INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
2868 fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
2871 #if defined(PROFILING)
2872 fprintf(stderr,"Cost Centre (???): 0x%lx\n",INFO_CAT(info_ptr));
2875 #if defined(_INFO_COPYING)
2876 fprintf(stderr,"Evacuate Entry: 0x%lx;\tScavenge Entry: 0x%lx\n",
2877 INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
2880 #if defined(_INFO_COMPACTING)
2881 fprintf(stderr,"Scan Link: 0x%lx;\tScan Move: 0x%lx\n",
2882 (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
2883 fprintf(stderr,"Mark: 0x%lx;\tMarked: 0x%lx;\t",
2884 (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
2885 #if 0 /* avoid INFO_TYPE */
2886 if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
2887 fprintf(stderr,"plus specialised code\n");
2889 fprintf(stderr,"Marking: 0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
2891 #endif /* _INFO_COMPACTING */
2896 The remaining debugging routines are more or less specific for GrAnSim.
2899 #if defined(GRAN) && defined(GRAN_CHECK)
2901 DEBUG_CURR_THREADQ(verbose)
2904 fprintf(stderr,"Thread Queue on proc %d: ", CurrentProc);
2905 DEBUG_THREADQ(ThreadQueueHd, verbose);
2909 DEBUG_THREADQ(closure, verbose)
2915 fprintf(stderr,"Thread Queue: ");
2916 for (x=closure; x!=Prelude_Z91Z93_closure; x=TSO_LINK(x))
2920 fprintf(stderr," 0x%x",x);
2922 if (closure==Prelude_Z91Z93_closure)
2923 fprintf(stderr,"NIL\n");
2925 fprintf(stderr,"\n");
2928 /* Check with Threads.lh */
2929 static char *type_name[] = { "T_MAIN", "T_REQUIRED", "T_ADVISORY", "T_FAIL"};
2932 DEBUG_TSO(closure,verbose)
2937 if (closure==Prelude_Z91Z93_closure) {
2938 fprintf(stderr,"TSO at 0x%x is Prelude_Z91Z93_closure!\n");
2942 fprintf(stderr,"TSO at 0x%x has the following contents:\n",closure);
2944 fprintf(stderr,"> Name: 0x%x",TSO_NAME(closure));
2945 fprintf(stderr,"\tLink: 0x%x\n",TSO_LINK(closure));
2946 fprintf(stderr,"> Id: 0x%x",TSO_ID(closure));
2947 #if defined(GRAN_CHECK) && defined(GRAN)
2948 if (RTSflags.GranFlags.debug & 0x10)
2949 fprintf(stderr,"\tType: %s %s\n",
2950 type_name[TSO_TYPE(closure) & ~FETCH_MASK_TSO],
2951 (TSO_TYPE(closure) & FETCH_MASK_TSO) ? "SLEEPING" : "");
2953 fprintf(stderr,"\tType: %s\n",type_name[TSO_TYPE(closure)]);
2955 fprintf(stderr,"\tType: %s\n",type_name[TSO_TYPE(closure)]);
2957 fprintf(stderr,"> PC1: 0x%x",TSO_PC1(closure));
2958 fprintf(stderr,"\tPC2: 0x%x\n",TSO_PC2(closure));
2959 fprintf(stderr,"> ARG1: 0x%x",TSO_ARG1(closure));
2960 /* fprintf(stderr,"\tARG2: 0x%x\n",TSO_ARG2(closure)); */
2961 fprintf(stderr,"> SWITCH: 0x%x\n", TSO_SWITCH(closure));
2964 fprintf(stderr,"} LOCKED: 0x%x",TSO_LOCKED(closure));
2965 fprintf(stderr,"\tSPARKNAME: 0x%x\n", TSO_SPARKNAME(closure));
2966 fprintf(stderr,"} STARTEDAT: 0x%x", TSO_STARTEDAT(closure));
2967 fprintf(stderr,"\tEXPORTED: 0x%x\n", TSO_EXPORTED(closure));
2968 fprintf(stderr,"} BASICBLOCKS: 0x%x", TSO_BASICBLOCKS(closure));
2969 fprintf(stderr,"\tALLOCS: 0x%x\n", TSO_ALLOCS(closure));
2970 fprintf(stderr,"} EXECTIME: 0x%x", TSO_EXECTIME(closure));
2971 fprintf(stderr,"\tFETCHTIME: 0x%x\n", TSO_FETCHTIME(closure));
2972 fprintf(stderr,"} FETCHCOUNT: 0x%x", TSO_FETCHCOUNT(closure));
2973 fprintf(stderr,"\tBLOCKTIME: 0x%x\n", TSO_BLOCKTIME(closure));
2974 fprintf(stderr,"} BLOCKCOUNT: 0x%x", TSO_BLOCKCOUNT(closure));
2975 fprintf(stderr,"\tBLOCKEDAT: 0x%x\n", TSO_BLOCKEDAT(closure));
2976 fprintf(stderr,"} GLOBALSPARKS: 0x%x", TSO_GLOBALSPARKS(closure));
2977 fprintf(stderr,"\tLOCALSPARKS: 0x%x\n", TSO_LOCALSPARKS(closure));
2982 DEBUG_EVENT(event, verbose)
2989 fprintf(stderr," 0x%x",event);
2994 DEBUG_EVENTQ(verbose)
2999 fprintf(stderr,"Eventq (hd @0x%x):\n",EventHd);
3000 for (x=EventHd; x!=NULL; x=EVENT_NEXT(x)) {
3001 DEBUG_EVENT(x,verbose);
3004 fprintf(stderr,"NIL\n");
3006 fprintf(stderr,"\n");
3010 DEBUG_SPARK(spark, verbose)
3017 fprintf(stderr," 0x%x",spark);
3021 DEBUG_SPARKQ(spark,verbose)
3027 fprintf(stderr,"Sparkq (hd @0x%x):\n",spark);
3028 for (x=spark; x!=NULL; x=SPARK_NEXT(x)) {
3029 DEBUG_SPARK(x,verbose);
3032 fprintf(stderr,"NIL\n");
3034 fprintf(stderr,"\n");
3038 DEBUG_CURR_SPARKQ(verbose)
3041 DEBUG_SPARKQ(SparkQueueHd,verbose);
3045 DEBUG_PROC(proc,verbose)
3049 fprintf(stderr,"Status of proc %d at time %d (0x%x): %s\n",
3050 proc,CurrentTime[proc],CurrentTime[proc],
3051 (CurrentProc==proc)?"ACTIVE":"INACTIVE");
3052 DEBUG_THREADQ(RunnableThreadsHd[proc],verbose & 0x2);
3053 if ( (CurrentProc==proc) )
3054 DEBUG_TSO(CurrentTSO,1);
3057 fprintf(stderr,"Next event (%s) is on proc %d\n",
3058 event_names[EVENT_TYPE(EventHd)],EVENT_PROC(EventHd));
3060 if (verbose & 0x1) {
3061 fprintf(stderr,"\nREQUIRED sparks: ");
3062 DEBUG_SPARKQ(PendingSparksHd[proc][REQUIRED_POOL],1);
3063 fprintf(stderr,"\nADVISORY_sparks: ");
3064 DEBUG_SPARKQ(PendingSparksHd[proc][ADVISORY_POOL],1);
3068 /* Debug CurrentTSO */
3071 fprintf(stderr,"Current Proc: %d\n",CurrentProc);
3072 DEBUG_TSO(CurrentTSO,1);
3075 /* Debug Current Processor */
3077 DCP(){ DEBUG_PROC(CurrentProc,2); }
3079 /* Shorthand for debugging event queue */
3081 DEQ() { DEBUG_EVENTQ(1); }
3083 /* Shorthand for debugging spark queue */
3085 DSQ() { DEBUG_CURR_SPARKQ(1); }
3087 /* Shorthand for printing a node */
3089 DN(P_ node) { DEBUG_PRINT_NODE(node); }