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 StgDouble LngReg1 = SAVE_Lng1;
1566 StgDouble LngReg2 = SAVE_Lng2;
1569 fprintf(stderr,"STG-Machine Register Values:\n\n");
1570 fprintf(stderr,"Node: %08lx; Hp: %08lx; HpLim: %08lx; Tag: %8lu\n",Node,(W_)Hp,(W_)HpLim,TagReg);
1571 fprintf(stderr,"SpA: %08lx; SpB: %08lx; SuA: %08lx; SuB: %08lx\n",(W_)SpA,(W_)SpB,(W_)SuA,(W_)SuB);
1572 fprintf(stderr,"RetReg: %08lx\n",RetReg);
1575 /* These bits need to have the FLUSH_REG_MAP, whereas the surrounding bits
1576 use the MAIN_REG_MAP */
1578 fprintf(stderr, "\n");
1579 fprintf(stderr,"LiveR: %08lx\n", LivenessReg);
1580 fprintf(stderr,"Flush: %08lx; FStk: %08lx; FStkB: %08lx; FTmp: %08lx\n",(W_)FlushP,(W_)FStack,(W_)FStackBase,(W_)Temp);
1583 fprintf(stderr, "\n");
1585 fprintf(stderr,"Gen: %8lu, %8lu, %8lu, %8lu\n",R1.i,R2.i,R3.i,R4.i);
1586 fprintf(stderr," %8lu, %8lu, %8lu, %8lu\n",R5.i,R6.i,R7.i,R8.i);
1587 fprintf(stderr,"Float: %8g, %8g, %8g, %8g\n",FltReg1,FltReg2,FltReg3,FltReg4);
1588 fprintf(stderr,"Dble: %8g, %8g\n",DblReg1,DblReg2);
1590 fprintf(stderr,"Long: %8lu, %8lu\n",LngReg1,LngReg2);
1602 fprintf(stderr,"ForeignObjList\n\n");
1604 for(mp = StorageMgrInfo.ForeignObjList;
1606 mp = ForeignObj_CLOSURE_LINK(mp)) {
1609 "ForeignObjPtr(0x%lx) = 0x%lx, finaliser: 0x%lx\n",
1611 ForeignObj_CLOSURE_DATA(mp),
1612 ForeignObj_CLOSURE_FINALISER(mp));
1615 DEBUG_PRINT_NODE(mp);
1619 # if defined(GCap) || defined(GCgn)
1620 fprintf(stderr,"\nOldForeignObj List\n\n");
1622 for(mp = StorageMgrInfo.OldForeignObjList;
1624 mp = ForeignObj_CLOSURE_LINK(mp)) {
1627 "ForeignObj(0x%lx) = 0x%lx, finaliser: 0x%lx\n",
1629 ForeignObj_CLOSURE_DATA(mp),
1630 ForeignObj_CLOSURE_FINALISER(mp));
1632 DEBUG_PRINT_NODE(mp);
1635 # endif /* GCap || GCgn */
1637 fprintf(stderr, "\n");
1641 DEBUG_SPT(int weight)
1643 StgPtr SPTable = StorageMgrInfo.StablePointerTable;
1644 StgInt size = SPT_SIZE(SPTable);
1645 StgInt ptrs = SPT_NoPTRS(SPTable);
1646 StgInt top = SPT_TOP(SPTable);
1651 DEBUG_PRINT_NODE(SPTable);
1654 fprintf(stderr,"SPTable@0x%lx:\n", SPTable);
1655 fprintf(stderr," InfoPtr = 0x%lx\n", INFO_PTR(SPTable));
1656 fprintf(stderr," size = %d, ptrs = %d, top = %d\n",
1659 for( i=0; i < ptrs; i++ ) {
1661 fprintf(stderr,"\n ");
1663 printClosure(SPT_SPTR(SPTable, i),1,weight);
1664 fprintf(stderr, "\n");
1666 fprintf(stderr, "\n");
1667 for( i=0; i < top; i++) {
1669 fprintf(stderr,"\n ");
1671 fprintf(stderr, " %3d", SPT_FREE(SPTable, i));
1674 fprintf(stderr, "\n\n");
1677 #endif /* !CONCURRENT */
1680 These routines crawl over the A and B stacks, printing
1681 a maximum "lines" lines at the top of the stack.
1684 #define STACK_VALUES_PER_LINE 5
1687 /* (stack stuff is really different on parallel machines) */
1701 fprintf(stderr,"Dump of the Address Stack, SpA: 0x%08lx, BOS: 0x%08lx\n",
1702 (W_) SpA, (W_) stackInfo.botA);
1704 for (stackptr = SpA;
1705 SUBTRACT_A_STK(stackptr, stackInfo.botA) >= 0;
1706 stackptr = stackptr + AREL(1))
1708 if( count++ % STACK_VALUES_PER_LINE == 0)
1710 if(count >= lines * STACK_VALUES_PER_LINE)
1712 fprintf(stderr,"\nSpA[%ld] (0x%08lx): ",count-1,stackptr);
1714 fprintf(stderr,"0x%08lx ",(W_) *stackptr);
1716 fprintf(stderr, "\n");
1731 fprintf(stderr,"Dump of the Value Stack, SpB: 0x%08lx, BOS: 0x%08lx\n",
1732 (W_) SpB, (W_) stackInfo.botB);
1734 for (stackptr = SpB;
1735 SUBTRACT_B_STK(stackptr, stackInfo.botB) > 0;
1736 stackptr = stackptr + BREL(1))
1738 if( count++ % STACK_VALUES_PER_LINE == 0)
1740 if(count >= lines * STACK_VALUES_PER_LINE)
1742 fprintf(stderr,"\nSpB[%ld] (0x%08lx): ",count-1,stackptr);
1744 fprintf(stderr,"0x%08lx ",(W_) *stackptr);
1746 fprintf(stderr, "\n");
1750 #endif /* not concurrent */
1753 This should disentangle update frames from both stacks.
1758 DEBUG_UPDATES(limit)
1771 fprintf(stderr,"Update Frame Stack Dump:\n\n");
1773 for(spa = SuA, spb = SuB;
1774 SUBTRACT_B_STK(spb, stackInfo.botB) > 0 && count++ < limit;
1775 spa = GRAB_SuA(spb), spb = GRAB_SuB(spb) ) {
1777 updatee = GRAB_UPDATEE(spb); /* Thing to be updated */
1778 retreg = (P_) GRAB_RET(spb); /* Return vector below */
1780 fprintf(stderr,"SuA: 0x%08lx, SuB: 0x%08lx, Updatee 0x%08lx (Info 0x%08lx), RetReg 0x%x\n",
1782 (W_) updatee, (W_) INFO_PTR(updatee), (W_) retreg);
1786 #endif /* not concurrent */
1795 STGRegisterTable *r = TSO_INTERNAL_PTR(tso);
1796 W_ liveness = r->rLiveness;
1799 fprintf(stderr,"TSO:\ntso=%lx, regs=%lx, liveness=%lx\nlink=%lx,name=%lx,id=%lx,type=%lx,pc1=%lx,arg1=%lx,switch=%lx\n"
1812 for (i = 0; liveness != 0; liveness >>= 1, i++) {
1814 fprintf(stderr, "live reg %d (%lx)\n",i, r->rR[i].p);
1816 fprintf(stderr, "reg %d (%lx) not live\n", i, r->rR[i].p);
1821 #endif /* concurrent */
1824 %****************************************************************************
1826 \subsection[GrAnSim-debug]{Debugging routines for GrAnSim}
1828 %****************************************************************************
1830 Debugging routines, mainly for GrAnSim.
1831 They should really be in a separate file.
1832 There is some code duplication of above routines in here, I'm afraid.
1834 As a naming convention all GrAnSim debugging functions start with @G_@.
1835 The shorthand forms defined at the end start only with @G@.
1838 #if defined(GRAN) && defined(GRAN_CHECK)
1840 #define NULL_REG_MAP /* Not threaded */
1841 /* #include "stgdefs.h" */
1844 info_hdr_type(info_ptr)
1847 #if ! defined(PAR) && !defined(GRAN)
1848 switch (INFO_TAG(info_ptr))
1850 case INFO_OTHER_TAG:
1851 return("OTHER_TAG");
1852 /* case INFO_IND_TAG:
1858 switch(BASE_INFO_TYPE(info_ptr))
1860 case INFO_SPEC_TYPE:
1869 case INFO_TUPLE_TYPE:
1872 case INFO_DATA_TYPE:
1875 case INFO_MUTUPLE_TYPE:
1878 case INFO_IMMUTUPLE_TYPE:
1879 return("IMMUTUPLE");
1881 case INFO_STATIC_TYPE:
1884 case INFO_CONST_TYPE:
1887 case INFO_CHARLIKE_TYPE:
1890 case INFO_INTLIKE_TYPE:
1911 case INFO_STKO_TYPE:
1914 case INFO_SPEC_RBH_TYPE:
1917 case INFO_GEN_RBH_TYPE:
1923 case INFO_INTERNAL_TYPE:
1927 fprintf(stderr,"Unknown header type %lu\n",INFO_TYPE(info_ptr));
1934 info_type(infoptr, str)
1939 if ( IS_NF(infoptr) )
1940 strcat(str,"|_NF ");
1941 else if ( IS_MUTABLE(infoptr) )
1943 else if ( IS_STATIC(infoptr) )
1945 else if ( IS_UPDATABLE(infoptr) )
1947 else if ( IS_BIG_MOTHER(infoptr) )
1949 else if ( IS_BLACK_HOLE(infoptr) )
1951 else if ( IS_INDIRECTION(infoptr) )
1953 else if ( IS_THUNK(infoptr) )
1960 @var_hdr_size@ computes the size of the variable header for a closure.
1967 switch(INFO_TYPE(INFO_PTR(node)))
1969 case INFO_SPEC_U_TYPE: return(0); /* by decree */
1970 case INFO_SPEC_N_TYPE: return(0);
1971 case INFO_GEN_U_TYPE: return(GEN_VHS);
1972 case INFO_GEN_N_TYPE: return(GEN_VHS);
1973 case INFO_DYN_TYPE: return(DYN_VHS);
1975 case INFO_DYN_TYPE_N: return(DYN_VHS);
1976 case INFO_DYN_TYPE_U: return(DYN_VHS);
1978 case INFO_TUPLE_TYPE: return(TUPLE_VHS);
1979 case INFO_DATA_TYPE: return(DATA_VHS);
1980 case INFO_MUTUPLE_TYPE: return(MUTUPLE_VHS);
1981 case INFO_IMMUTUPLE_TYPE: return(MUTUPLE_VHS); /* same layout */
1982 case INFO_STATIC_TYPE: return(STATIC_VHS);
1983 case INFO_CONST_TYPE: return(0);
1984 case INFO_CHARLIKE_TYPE: return(0);
1985 case INFO_INTLIKE_TYPE: return(0);
1986 case INFO_BH_TYPE: return(0);
1987 case INFO_IND_TYPE: return(0);
1988 case INFO_CAF_TYPE: return(0);
1989 case INFO_FETCHME_TYPE: return(0);
1990 case INFO_BQ_TYPE: return(0);
1992 case INFO_BQENT_TYPE: return(0);
1994 case INFO_TSO_TYPE: return(TSO_VHS);
1995 case INFO_STKO_TYPE: return(STKO_VHS);
1997 fprintf(stderr,"Unknown info type 0x%lx (%lu)\n", INFO_PTR(node),
1998 INFO_TYPE(INFO_PTR(node)));
2004 /* Determine the size and number of pointers for this kind of closure */
2006 size_and_ptrs(node,size,ptrs)
2010 switch(INFO_TYPE(INFO_PTR(node)))
2012 case INFO_SPEC_U_TYPE:
2013 case INFO_SPEC_N_TYPE:
2014 *size = INFO_SIZE(INFO_PTR(node)); /* New for 0.24; check */
2015 *ptrs = INFO_NoPTRS(INFO_PTR(node)); /* that! -- HWL */
2017 *size = SPEC_CLOSURE_SIZE(node);
2018 *ptrs = SPEC_CLOSURE_NoPTRS(node);
2022 case INFO_GEN_U_TYPE:
2023 case INFO_GEN_N_TYPE:
2024 *size = GEN_CLOSURE_SIZE(node);
2025 *ptrs = GEN_CLOSURE_NoPTRS(node);
2029 case INFO_DYN_TYPE_U:
2030 case INFO_DYN_TYPE_N:
2033 *size = DYN_CLOSURE_SIZE(node);
2034 *ptrs = DYN_CLOSURE_NoPTRS(node);
2037 case INFO_TUPLE_TYPE:
2038 *size = TUPLE_CLOSURE_SIZE(node);
2039 *ptrs = TUPLE_CLOSURE_NoPTRS(node);
2042 case INFO_DATA_TYPE:
2043 *size = DATA_CLOSURE_SIZE(node);
2044 *ptrs = DATA_CLOSURE_NoPTRS(node);
2048 *size = IND_CLOSURE_SIZE(node);
2049 *ptrs = IND_CLOSURE_NoPTRS(node);
2052 /* ToDo: more (WDP) */
2054 /* Don't know about the others */
2065 P_ info_ptr, bqe; /* = INFO_PTR(node); */
2066 I_ size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0;
2067 char info_hdr_ty[80], info_ty[80];
2070 fprintf(stderr,"NULL\n");
2072 } else if (node==PrelBase_Z91Z93_closure) {
2073 fprintf(stderr,"PrelBase_Z91Z93_closure\n");
2075 } else if (node==MUT_NOT_LINKED) {
2076 fprintf(stderr,"MUT_NOT_LINKED\n");
2079 /* size_and_ptrs(node,&size,&ptrs); */
2080 info_ptr = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_hdr_ty);
2082 /* vhs = var_hdr_size(node); */
2083 info_type(info_ptr,info_ty);
2085 fprintf(stderr,"Node: 0x%lx", (W_) node);
2088 fprintf(stderr," [GA: 0x%lx]",GA(node));
2091 #if defined(USE_COST_CENTRES)
2092 fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
2096 fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
2099 if (info_ptr==INFO_TSO_TYPE)
2100 fprintf(stderr," TSO: 0x%lx (%x) IP: 0x%lx (%s), type %s \n ",
2101 node, TSO_ID(node), info_ptr, info_hdr_ty, info_ty);
2103 fprintf(stderr," IP: 0x%lx (%s), type %s \n VHS: %d, size: %ld, ptrs:%ld, nonptrs: %ld\n ",
2104 info_ptr,info_hdr_ty,info_ty,vhs,size,ptrs,nonptrs);
2106 /* For now, we ignore the variable header */
2108 fprintf(stderr," Ptrs: ");
2109 for(i=0; i < ptrs; ++i)
2111 if ( (i+1) % 6 == 0)
2112 fprintf(stderr,"\n ");
2113 fprintf(stderr," 0x%lx[P]",*(node+_FHS+vhs+i));
2116 fprintf(stderr," Data: ");
2117 for(i=0; i < nonptrs; ++i)
2120 fprintf(stderr,"\n ");
2121 fprintf(stderr," %lu[D]",*(node+_FHS+vhs+ptrs+i));
2123 fprintf(stderr, "\n");
2126 switch (INFO_TYPE(info_ptr))
2129 fprintf(stderr,"\n TSO_LINK: %#lx",
2135 bqe = (P_)BQ_ENTRIES(node);
2136 fprintf(stderr," BQ of %#lx: ", node);
2139 case INFO_FMBQ_TYPE:
2140 printf("Panic: found FMBQ Infotable in GrAnSim system.\n");
2142 case INFO_SPEC_RBH_TYPE:
2143 bqe = (P_)SPEC_RBH_BQ(node);
2144 fprintf(stderr," BQ of %#lx: ", node);
2147 case INFO_GEN_RBH_TYPE:
2148 bqe = (P_)GEN_RBH_BQ(node);
2149 fprintf(stderr," BQ of %#lx: ", node);
2156 G_PPN(node) /* Extracted from PrintPacket in Pack.lc */
2160 I_ size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0, locn = 0;
2163 /* size_and_ptrs(node,&size,&ptrs); */
2164 info = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_type);
2166 if (INFO_TYPE(info) == INFO_FETCHME_TYPE || IS_BLACK_HOLE(info))
2167 size = ptrs = nonptrs = vhs = 0;
2169 if (IS_THUNK(info)) {
2170 if (IS_UPDATABLE(info))
2171 fputs("SHARED ", stderr);
2173 fputs("UNSHARED ", stderr);
2175 if (IS_BLACK_HOLE(info)) {
2176 fputs("BLACK HOLE\n", stderr);
2179 fprintf(stderr, "(%s) FH [%#lx", info_type, node[locn++]);
2180 for (i = 1; i < FIXED_HS; i++)
2181 fprintf(stderr, " %#lx", node[locn++]);
2183 /* Variable header */
2185 fprintf(stderr, "] VH [%#lx", node[locn++]);
2187 for (i = 1; i < vhs; i++)
2188 fprintf(stderr, " %#lx", node[locn++]);
2191 fprintf(stderr, "] PTRS %u", ptrs);
2195 fprintf(stderr, " NPTRS [%#lx", node[locn++]);
2197 for (i = 1; i < nonptrs; i++)
2198 fprintf(stderr, " %#lx", node[locn++]);
2207 #define INFO_MASK 0x80000000
2210 G_MUT(node,verbose) /* Print mutables list starting with node */
2213 if (verbose & 0x1) { G_PRINT_NODE(node); fprintf(stderr, "\n"); }
2214 else fprintf(stderr, "0x%#lx, ", node);
2216 if (node==NULL || node==PrelBase_Z91Z93_closure || node==MUT_NOT_LINKED) {
2219 G_MUT(MUT_LINK(node), verbose);
2227 W_ size = 0, ptrs = 0, i, vhs = 0;
2229 /* Don't print cycles */
2230 if((INFO_PTR(node) & INFO_MASK) != 0)
2233 size_and_ptrs(node,&size,&ptrs);
2234 vhs = var_hdr_size(node);
2237 fprintf(stderr, "\n");
2239 /* Mark the node -- may be dangerous */
2240 INFO_PTR(node) |= INFO_MASK;
2242 for(i = 0; i < ptrs; ++i)
2243 G_TREE((P_)node[i+vhs+_FHS]);
2245 /* Unmark the node */
2246 INFO_PTR(node) &= ~INFO_MASK;
2254 P_ info_ptr = (P_)INFO_PTR(node);
2255 char *ip_type = info_hdr_type(info_ptr);
2257 fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
2258 ip_type,info_ptr,(W_) ENTRY_CODE(info_ptr),INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
2260 if (IS_THUNK(info_ptr) && IS_UPDATABLE(info_ptr) ) {
2261 fprintf(stderr," RBH InfoPtr: %#lx\n",
2262 RBH_INFOPTR(info_ptr));
2266 fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
2269 #if defined(USE_COST_CENTRES)
2270 fprintf(stderr,"Cost Centre (???): 0x%lx\n",INFO_CAT(info_ptr));
2273 #if defined(_INFO_COPYING)
2274 fprintf(stderr,"Evacuate Entry: 0x%lx;\tScavenge Entry: 0x%lx\n",
2275 INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
2278 #if defined(_INFO_COMPACTING)
2279 fprintf(stderr,"Scan Link: 0x%lx;\tScan Move: 0x%lx\n",
2280 (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
2281 fprintf(stderr,"Mark: 0x%lx;\tMarked: 0x%lx;\t",
2282 (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
2283 #if 0 /* avoid INFO_TYPE */
2284 if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
2285 fprintf(stderr,"plus specialised code\n");
2287 fprintf(stderr,"Marking: 0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
2289 #endif /* _INFO_COMPACTING */
2295 The remaining debugging routines are more or less specific for GrAnSim.
2298 #if defined(GRAN) && defined(GRAN_CHECK)
2300 G_CURR_THREADQ(verbose)
2303 fprintf(stderr,"Thread Queue on proc %d: ", CurrentProc);
2304 G_THREADQ(ThreadQueueHd, verbose);
2308 G_THREADQ(closure, verbose)
2314 fprintf(stderr,"Thread Queue: ");
2315 for (x=closure; x!=PrelBase_Z91Z93_closure; x=TSO_LINK(x))
2319 fprintf(stderr," %#lx",x);
2321 if (closure==PrelBase_Z91Z93_closure)
2322 fprintf(stderr,"NIL\n");
2324 fprintf(stderr,"\n");
2327 /* Check with Threads.lh */
2328 static char *type_name[] = { "T_MAIN", "T_REQUIRED", "T_ADVISORY", "T_FAIL"};
2331 G_TSO(closure,verbose)
2336 if (closure==PrelBase_Z91Z93_closure) {
2337 fprintf(stderr,"TSO at %#lx is PrelBase_Z91Z93_closure!\n");
2341 if ( verbose & 0x08 ) { /* short info */
2342 fprintf(stderr,"[TSO @ %#lx, PE %d]: Name: %#lx, Id: %#lx, Link: %#lx\n",
2343 closure,where_is(closure),
2344 TSO_NAME(closure),TSO_ID(closure),TSO_LINK(closure));
2348 fprintf(stderr,"TSO at %#lx has the following contents:\n",
2351 fprintf(stderr,"> Name: \t%#lx",TSO_NAME(closure));
2352 fprintf(stderr,"\tLink: \t%#lx\n",TSO_LINK(closure));
2353 fprintf(stderr,"> Id: \t%#lx",TSO_ID(closure));
2354 #if defined(GRAN_CHECK) && defined(GRAN)
2355 if (RTSflags.GranFlags.debug & 0x10)
2356 fprintf(stderr,"\tType: \t%s %s\n",
2357 type_name[TSO_TYPE(closure) & ~FETCH_MASK_TSO],
2358 (TSO_TYPE(closure) & FETCH_MASK_TSO) ? "SLEEPING" : "");
2360 fprintf(stderr,"\tType: \t%s\n",type_name[TSO_TYPE(closure)]);
2362 fprintf(stderr,"\tType: \t%s\n",type_name[TSO_TYPE(closure)]);
2364 fprintf(stderr,"> PC1: \t%#lx",TSO_PC1(closure));
2365 fprintf(stderr,"\tPC2: \t%#lx\n",TSO_PC2(closure));
2366 fprintf(stderr,"> ARG1: \t%#lx",TSO_ARG1(closure));
2367 /* fprintf(stderr,"\tARG2: \t%#lx\n",TSO_ARG2(closure)); */
2368 fprintf(stderr,"> SWITCH: \t%#lx", TSO_SWITCH(closure));
2369 #if defined(GRAN_PRI_SCHED)
2370 fprintf(stderr,"\tPRI: \t%#lx\n", TSO_PRI(closure));
2372 fprintf(stderr,"\n");
2375 fprintf(stderr,"} LOCKED: \t%#lx",TSO_LOCKED(closure));
2376 fprintf(stderr,"\tSPARKNAME: \t%#lx\n", TSO_SPARKNAME(closure));
2377 fprintf(stderr,"} STARTEDAT: \t%#lx", TSO_STARTEDAT(closure));
2378 fprintf(stderr,"\tEXPORTED: \t%#lx\n", TSO_EXPORTED(closure));
2379 fprintf(stderr,"} BASICBLOCKS: \t%#lx", TSO_BASICBLOCKS(closure));
2380 fprintf(stderr,"\tALLOCS: \t%#lx\n", TSO_ALLOCS(closure));
2381 fprintf(stderr,"} EXECTIME: \t%#lx", TSO_EXECTIME(closure));
2382 fprintf(stderr,"\tFETCHTIME: \t%#lx\n", TSO_FETCHTIME(closure));
2383 fprintf(stderr,"} FETCHCOUNT: \t%#lx", TSO_FETCHCOUNT(closure));
2384 fprintf(stderr,"\tBLOCKTIME: \t%#lx\n", TSO_BLOCKTIME(closure));
2385 fprintf(stderr,"} BLOCKCOUNT: \t%#lx", TSO_BLOCKCOUNT(closure));
2386 fprintf(stderr,"\tBLOCKEDAT: \t%#lx\n", TSO_BLOCKEDAT(closure));
2387 fprintf(stderr,"} GLOBALSPARKS:\t%#lx", TSO_GLOBALSPARKS(closure));
2388 fprintf(stderr,"\tLOCALSPARKS:\t%#lx\n", TSO_LOCALSPARKS(closure));
2390 #if defined(GRAN_CHECK)
2391 if ( verbose & 0x02 ) {
2392 fprintf(stderr,"BQ that starts with this TSO: ");
2399 G_EVENT(event, verbose)
2406 fprintf(stderr," %#lx",event);
2416 fprintf(stderr,"Eventq (hd @%#lx):\n",EventHd);
2417 for (x=EventHd; x!=NULL; x=EVENT_NEXT(x)) {
2421 fprintf(stderr,"NIL\n");
2423 fprintf(stderr,"\n");
2433 fprintf(stderr,"Eventq (hd @%#lx):\n",EventHd);
2434 for (x=EventHd; x!=NULL; x=EVENT_NEXT(x)) {
2435 if (EVENT_PROC(x)==pe)
2439 fprintf(stderr,"NIL\n");
2441 fprintf(stderr,"\n");
2445 G_SPARK(spark, verbose)
2452 fprintf(stderr," %#lx",spark);
2456 G_SPARKQ(spark,verbose)
2462 fprintf(stderr,"Sparkq (hd @%#lx):\n",spark);
2463 for (x=spark; x!=NULL; x=SPARK_NEXT(x)) {
2467 fprintf(stderr,"NIL\n");
2469 fprintf(stderr,"\n");
2473 G_CURR_SPARKQ(verbose)
2476 G_SPARKQ(SparkQueueHd,verbose);
2480 G_PROC(proc,verbose)
2484 extern char *proc_status_names[];
2486 fprintf(stderr,"Status of proc %d at time %d (%#lx): %s (%s)\n",
2487 proc,CurrentTime[proc],CurrentTime[proc],
2488 (CurrentProc==proc)?"ACTIVE":"INACTIVE",
2489 proc_status_names[procStatus[proc]]);
2490 G_THREADQ(RunnableThreadsHd[proc],verbose & 0x2);
2491 if ( (CurrentProc==proc) )
2492 G_TSO(CurrentTSO,1);
2495 fprintf(stderr,"Next event (%s) is on proc %d\n",
2496 event_names[EVENT_TYPE(EventHd)],EVENT_PROC(EventHd));
2498 if (verbose & 0x1) {
2499 fprintf(stderr,"\nREQUIRED sparks: ");
2500 G_SPARKQ(PendingSparksHd[proc][REQUIRED_POOL],1);
2501 fprintf(stderr,"\nADVISORY_sparks: ");
2502 G_SPARKQ(PendingSparksHd[proc][ADVISORY_POOL],1);
2506 /* Debug Processor */
2513 /* Debug Current Processor */
2515 GCP(){ G_PROC(CurrentProc,2); }
2523 /* Debug CurrentTSO */
2526 fprintf(stderr,"Current Proc: %d\n",CurrentProc);
2527 G_TSO(CurrentTSO,1);
2530 /* Shorthand for debugging event queue */
2532 GEQ() { G_EVENTQ(1); }
2534 /* Shorthand for debugging thread queue of a processor */
2536 GTQ(PROC p) { G_THREADQ(RunnableThreadsHd[p],1); }
2538 /* Shorthand for debugging thread queue of current processor */
2540 GCTQ() { G_THREADQ(RunnableThreadsHd[CurrentProc],1); }
2542 /* Shorthand for debugging spark queue of a processor */
2544 GSQ(PROC p) { G_SPARKQ(PendingSparksHd[p][1],1); }
2546 /* Shorthand for debugging spark queue of current processor */
2548 GCSQ() { G_CURR_SPARKQ(1); }
2550 /* Shorthand for printing a node */
2552 GN(P_ node) { G_PRINT_NODE(node); }
2554 /* Shorthand for printing info table */
2556 GIT(P_ node) { G_INFO_TABLE(node); }
2558 /* Shorthand for some of ADRs debugging functions */
2561 pC(P_ closure) { printClosure(closure, 0/*indentation*/, 10/*weight*/); }
2563 /* Print a closure on the heap */
2565 DN(P_ closure) { DEBUG_NODE( closure, 1/*size*/ );}
2567 /* Print info-table of a closure */
2569 DIT(P_ closure) { DEBUG_INFO_TABLE(closure); }
2571 /* (CONCURRENT) Print a Thread State Object */
2573 DT(P_ tso) { DEBUG_TSO(tso); }
2575 /* Not yet implemented: */
2576 /* (CONCURRENT) Print a STacK Object
2578 DS(P_ stko) { DEBUG_STKO(stko) ; }
2583 /* --------------------------- vvvv old vvvvv ------------------------*/
2585 #if 0 /* ngo' ngoq! veQ yIboS! */
2587 #define NULL_REG_MAP /* Not threaded */
2588 #include "stgdefs.h"
2591 info_hdr_type(info_ptr)
2594 #if ! defined(PAR) && !defined(GRAN)
2595 switch (INFO_TAG(info_ptr))
2597 case INFO_OTHER_TAG:
2598 return("OTHER_TAG");
2599 /* case INFO_IND_TAG:
2605 switch(INFO_TYPE(info_ptr))
2607 case INFO_SPEC_U_TYPE:
2610 case INFO_SPEC_N_TYPE:
2613 case INFO_GEN_U_TYPE:
2616 case INFO_GEN_N_TYPE:
2623 case INFO_DYN_TYPE_N:
2626 case INFO_DYN_TYPE_U:
2630 case INFO_TUPLE_TYPE:
2633 case INFO_DATA_TYPE:
2636 case INFO_MUTUPLE_TYPE:
2639 case INFO_IMMUTUPLE_TYPE:
2640 return("IMMUTUPLE");
2642 case INFO_STATIC_TYPE:
2645 case INFO_CONST_TYPE:
2648 case INFO_CHARLIKE_TYPE:
2651 case INFO_INTLIKE_TYPE:
2663 case INFO_FETCHME_TYPE:
2670 case INFO_BQENT_TYPE:
2677 case INFO_STKO_TYPE:
2681 fprintf(stderr,"Unknown header type %lu\n",INFO_TYPE(info_ptr));
2688 @var_hdr_size@ computes the size of the variable header for a closure.
2695 switch(INFO_TYPE(INFO_PTR(node)))
2697 case INFO_SPEC_U_TYPE: return(0); /* by decree */
2698 case INFO_SPEC_N_TYPE: return(0);
2699 case INFO_GEN_U_TYPE: return(GEN_VHS);
2700 case INFO_GEN_N_TYPE: return(GEN_VHS);
2701 case INFO_DYN_TYPE: return(DYN_VHS);
2703 case INFO_DYN_TYPE_N: return(DYN_VHS);
2704 case INFO_DYN_TYPE_U: return(DYN_VHS);
2706 case INFO_TUPLE_TYPE: return(TUPLE_VHS);
2707 case INFO_DATA_TYPE: return(DATA_VHS);
2708 case INFO_MUTUPLE_TYPE: return(MUTUPLE_VHS);
2709 case INFO_IMMUTUPLE_TYPE: return(MUTUPLE_VHS); /* same layout */
2710 case INFO_STATIC_TYPE: return(STATIC_VHS);
2711 case INFO_CONST_TYPE: return(0);
2712 case INFO_CHARLIKE_TYPE: return(0);
2713 case INFO_INTLIKE_TYPE: return(0);
2714 case INFO_BH_TYPE: return(0);
2715 case INFO_IND_TYPE: return(0);
2716 case INFO_CAF_TYPE: return(0);
2717 case INFO_FETCHME_TYPE: return(0);
2718 case INFO_BQ_TYPE: return(0);
2720 case INFO_BQENT_TYPE: return(0);
2722 case INFO_TSO_TYPE: return(TSO_VHS);
2723 case INFO_STKO_TYPE: return(STKO_VHS);
2725 fprintf(stderr,"Unknown info type 0x%lx (%lu)\n", INFO_PTR(node),
2726 INFO_TYPE(INFO_PTR(node)));
2732 /* Determine the size and number of pointers for this kind of closure */
2734 size_and_ptrs(node,size,ptrs)
2738 switch(INFO_TYPE(INFO_PTR(node)))
2740 case INFO_SPEC_U_TYPE:
2741 case INFO_SPEC_N_TYPE:
2742 *size = INFO_SIZE(INFO_PTR(node)); /* New for 0.24; check */
2743 *ptrs = INFO_NoPTRS(INFO_PTR(node)); /* that! -- HWL */
2745 *size = SPEC_CLOSURE_SIZE(node);
2746 *ptrs = SPEC_CLOSURE_NoPTRS(node);
2750 case INFO_GEN_U_TYPE:
2751 case INFO_GEN_N_TYPE:
2752 *size = GEN_CLOSURE_SIZE(node);
2753 *ptrs = GEN_CLOSURE_NoPTRS(node);
2757 case INFO_DYN_TYPE_U:
2758 case INFO_DYN_TYPE_N:
2761 *size = DYN_CLOSURE_SIZE(node);
2762 *ptrs = DYN_CLOSURE_NoPTRS(node);
2765 case INFO_TUPLE_TYPE:
2766 *size = TUPLE_CLOSURE_SIZE(node);
2767 *ptrs = TUPLE_CLOSURE_NoPTRS(node);
2770 case INFO_DATA_TYPE:
2771 *size = DATA_CLOSURE_SIZE(node);
2772 *ptrs = DATA_CLOSURE_NoPTRS(node);
2776 *size = IND_CLOSURE_SIZE(node);
2777 *ptrs = IND_CLOSURE_NoPTRS(node);
2780 /* ToDo: more (WDP) */
2782 /* Don't know about the others */
2790 DEBUG_PRINT_NODE(node)
2793 W_ info_ptr = INFO_PTR(node);
2794 I_ size = 0, ptrs = 0, i, vhs = 0;
2795 char *info_type = info_hdr_type(info_ptr);
2797 size_and_ptrs(node,&size,&ptrs);
2798 vhs = var_hdr_size(node);
2800 fprintf(stderr,"Node: 0x%lx", (W_) node);
2803 fprintf(stderr," [GA: 0x%lx]",GA(node));
2806 #if defined(PROFILING)
2807 fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
2811 fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
2814 fprintf(stderr," IP: 0x%lx (%s), size %ld, %ld ptrs\n",
2815 info_ptr,info_type,size,ptrs);
2817 /* For now, we ignore the variable header */
2819 for(i=0; i < size; ++i)
2822 fprintf(stderr,"Data: ");
2825 fprintf(stderr,"\n ");
2828 fprintf(stderr," 0x%lx[P]",*(node+_FHS+vhs+i));
2830 fprintf(stderr," %lu[D]",*(node+_FHS+vhs+i));
2832 fprintf(stderr, "\n");
2836 #define INFO_MASK 0x80000000
2842 W_ size = 0, ptrs = 0, i, vhs = 0;
2844 /* Don't print cycles */
2845 if((INFO_PTR(node) & INFO_MASK) != 0)
2848 size_and_ptrs(node,&size,&ptrs);
2849 vhs = var_hdr_size(node);
2851 DEBUG_PRINT_NODE(node);
2852 fprintf(stderr, "\n");
2854 /* Mark the node -- may be dangerous */
2855 INFO_PTR(node) |= INFO_MASK;
2857 for(i = 0; i < ptrs; ++i)
2858 DEBUG_TREE((P_)node[i+vhs+_FHS]);
2860 /* Unmark the node */
2861 INFO_PTR(node) &= ~INFO_MASK;
2866 DEBUG_INFO_TABLE(node)
2869 W_ info_ptr = INFO_PTR(node);
2870 char *ip_type = info_hdr_type(info_ptr);
2872 fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
2873 ip_type,info_ptr,(W_) ENTRY_CODE(info_ptr),INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
2875 fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
2878 #if defined(PROFILING)
2879 fprintf(stderr,"Cost Centre (???): 0x%lx\n",INFO_CAT(info_ptr));
2882 #if defined(_INFO_COPYING)
2883 fprintf(stderr,"Evacuate Entry: 0x%lx;\tScavenge Entry: 0x%lx\n",
2884 INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
2887 #if defined(_INFO_COMPACTING)
2888 fprintf(stderr,"Scan Link: 0x%lx;\tScan Move: 0x%lx\n",
2889 (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
2890 fprintf(stderr,"Mark: 0x%lx;\tMarked: 0x%lx;\t",
2891 (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
2892 #if 0 /* avoid INFO_TYPE */
2893 if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
2894 fprintf(stderr,"plus specialised code\n");
2896 fprintf(stderr,"Marking: 0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
2898 #endif /* _INFO_COMPACTING */
2903 The remaining debugging routines are more or less specific for GrAnSim.
2906 #if defined(GRAN) && defined(GRAN_CHECK)
2908 DEBUG_CURR_THREADQ(verbose)
2911 fprintf(stderr,"Thread Queue on proc %d: ", CurrentProc);
2912 DEBUG_THREADQ(ThreadQueueHd, verbose);
2916 DEBUG_THREADQ(closure, verbose)
2922 fprintf(stderr,"Thread Queue: ");
2923 for (x=closure; x!=PrelBase_Z91Z93_closure; x=TSO_LINK(x))
2927 fprintf(stderr," 0x%x",x);
2929 if (closure==PrelBase_Z91Z93_closure)
2930 fprintf(stderr,"NIL\n");
2932 fprintf(stderr,"\n");
2935 /* Check with Threads.lh */
2936 static char *type_name[] = { "T_MAIN", "T_REQUIRED", "T_ADVISORY", "T_FAIL"};
2939 DEBUG_TSO(closure,verbose)
2944 if (closure==PrelBase_Z91Z93_closure) {
2945 fprintf(stderr,"TSO at 0x%x is PrelBase_Z91Z93_closure!\n");
2949 fprintf(stderr,"TSO at 0x%x has the following contents:\n",closure);
2951 fprintf(stderr,"> Name: 0x%x",TSO_NAME(closure));
2952 fprintf(stderr,"\tLink: 0x%x\n",TSO_LINK(closure));
2953 fprintf(stderr,"> Id: 0x%x",TSO_ID(closure));
2954 #if defined(GRAN_CHECK) && defined(GRAN)
2955 if (RTSflags.GranFlags.debug & 0x10)
2956 fprintf(stderr,"\tType: %s %s\n",
2957 type_name[TSO_TYPE(closure) & ~FETCH_MASK_TSO],
2958 (TSO_TYPE(closure) & FETCH_MASK_TSO) ? "SLEEPING" : "");
2960 fprintf(stderr,"\tType: %s\n",type_name[TSO_TYPE(closure)]);
2962 fprintf(stderr,"\tType: %s\n",type_name[TSO_TYPE(closure)]);
2964 fprintf(stderr,"> PC1: 0x%x",TSO_PC1(closure));
2965 fprintf(stderr,"\tPC2: 0x%x\n",TSO_PC2(closure));
2966 fprintf(stderr,"> ARG1: 0x%x",TSO_ARG1(closure));
2967 /* fprintf(stderr,"\tARG2: 0x%x\n",TSO_ARG2(closure)); */
2968 fprintf(stderr,"> SWITCH: 0x%x\n", TSO_SWITCH(closure));
2971 fprintf(stderr,"} LOCKED: 0x%x",TSO_LOCKED(closure));
2972 fprintf(stderr,"\tSPARKNAME: 0x%x\n", TSO_SPARKNAME(closure));
2973 fprintf(stderr,"} STARTEDAT: 0x%x", TSO_STARTEDAT(closure));
2974 fprintf(stderr,"\tEXPORTED: 0x%x\n", TSO_EXPORTED(closure));
2975 fprintf(stderr,"} BASICBLOCKS: 0x%x", TSO_BASICBLOCKS(closure));
2976 fprintf(stderr,"\tALLOCS: 0x%x\n", TSO_ALLOCS(closure));
2977 fprintf(stderr,"} EXECTIME: 0x%x", TSO_EXECTIME(closure));
2978 fprintf(stderr,"\tFETCHTIME: 0x%x\n", TSO_FETCHTIME(closure));
2979 fprintf(stderr,"} FETCHCOUNT: 0x%x", TSO_FETCHCOUNT(closure));
2980 fprintf(stderr,"\tBLOCKTIME: 0x%x\n", TSO_BLOCKTIME(closure));
2981 fprintf(stderr,"} BLOCKCOUNT: 0x%x", TSO_BLOCKCOUNT(closure));
2982 fprintf(stderr,"\tBLOCKEDAT: 0x%x\n", TSO_BLOCKEDAT(closure));
2983 fprintf(stderr,"} GLOBALSPARKS: 0x%x", TSO_GLOBALSPARKS(closure));
2984 fprintf(stderr,"\tLOCALSPARKS: 0x%x\n", TSO_LOCALSPARKS(closure));
2989 DEBUG_EVENT(event, verbose)
2996 fprintf(stderr," 0x%x",event);
3001 DEBUG_EVENTQ(verbose)
3006 fprintf(stderr,"Eventq (hd @0x%x):\n",EventHd);
3007 for (x=EventHd; x!=NULL; x=EVENT_NEXT(x)) {
3008 DEBUG_EVENT(x,verbose);
3011 fprintf(stderr,"NIL\n");
3013 fprintf(stderr,"\n");
3017 DEBUG_SPARK(spark, verbose)
3024 fprintf(stderr," 0x%x",spark);
3028 DEBUG_SPARKQ(spark,verbose)
3034 fprintf(stderr,"Sparkq (hd @0x%x):\n",spark);
3035 for (x=spark; x!=NULL; x=SPARK_NEXT(x)) {
3036 DEBUG_SPARK(x,verbose);
3039 fprintf(stderr,"NIL\n");
3041 fprintf(stderr,"\n");
3045 DEBUG_CURR_SPARKQ(verbose)
3048 DEBUG_SPARKQ(SparkQueueHd,verbose);
3052 DEBUG_PROC(proc,verbose)
3056 fprintf(stderr,"Status of proc %d at time %d (0x%x): %s\n",
3057 proc,CurrentTime[proc],CurrentTime[proc],
3058 (CurrentProc==proc)?"ACTIVE":"INACTIVE");
3059 DEBUG_THREADQ(RunnableThreadsHd[proc],verbose & 0x2);
3060 if ( (CurrentProc==proc) )
3061 DEBUG_TSO(CurrentTSO,1);
3064 fprintf(stderr,"Next event (%s) is on proc %d\n",
3065 event_names[EVENT_TYPE(EventHd)],EVENT_PROC(EventHd));
3067 if (verbose & 0x1) {
3068 fprintf(stderr,"\nREQUIRED sparks: ");
3069 DEBUG_SPARKQ(PendingSparksHd[proc][REQUIRED_POOL],1);
3070 fprintf(stderr,"\nADVISORY_sparks: ");
3071 DEBUG_SPARKQ(PendingSparksHd[proc][ADVISORY_POOL],1);
3075 /* Debug CurrentTSO */
3078 fprintf(stderr,"Current Proc: %d\n",CurrentProc);
3079 DEBUG_TSO(CurrentTSO,1);
3082 /* Debug Current Processor */
3084 DCP(){ DEBUG_PROC(CurrentProc,2); }
3086 /* Shorthand for debugging event queue */
3088 DEQ() { DEBUG_EVENTQ(1); }
3090 /* Shorthand for debugging spark queue */
3092 DSQ() { DEBUG_CURR_SPARKQ(1); }
3094 /* Shorthand for printing a node */
3096 DN(P_ node) { DEBUG_PRINT_NODE(node); }