1 /* -----------------------------------------------------------------------------
2 * $Id: Printer.c,v 1.57 2003/03/25 17:58:48 sof Exp $
4 * (c) The GHC Team, 1994-2000.
8 * ---------------------------------------------------------------------------*/
10 #include "PosixSource.h"
22 #include "Bytecodes.h" /* for InstrPtr */
23 #include "Disassembler.h"
28 #if defined(GRAN) || defined(PAR)
29 // HWL: explicit fixed header size to make debugging easier
30 int fixed_hs = FIXED_HS, itbl_sz = sizeofW(StgInfoTable),
31 uf_sz=sizeofW(StgUpdateFrame);
34 /* --------------------------------------------------------------------------
35 * local function decls
36 * ------------------------------------------------------------------------*/
38 static void printStdObject( StgClosure *obj, char* tag );
39 static void printStdObjPayload( StgClosure *obj );
41 static void reset_table ( int size );
42 static void prepare_table ( void );
43 static void insert ( unsigned value, const char *name );
45 #if 0 /* unused but might be useful sometime */
46 static rtsBool lookup_name ( char *name, unsigned *result );
47 static void enZcode ( char *in, char *out );
49 static char unZcode ( char ch );
50 const char * lookupGHCName ( void *addr );
51 static void printZcoded ( const char *raw );
53 /* --------------------------------------------------------------------------
55 * ------------------------------------------------------------------------*/
57 void printPtr( StgPtr p )
60 raw = lookupGHCName(p);
64 fprintf(stderr, "%p", p);
68 void printObj( StgClosure *obj )
70 fprintf(stderr,"Object "); printPtr((StgPtr)obj); fprintf(stderr," = ");
75 printStdObjHdr( StgClosure *obj, char* tag )
77 fprintf(stderr,"%s(",tag);
78 printPtr((StgPtr)obj->header.info);
80 fprintf(stderr,", %s", obj->header.prof.ccs->cc->label);
85 printStdObjPayload( StgClosure *obj )
88 const StgInfoTable* info;
91 for (i = 0; i < info->layout.payload.ptrs; ++i) {
93 printPtr((StgPtr)obj->payload[i]);
95 for (j = 0; j < info->layout.payload.nptrs; ++j) {
96 fprintf(stderr,", %pd#",obj->payload[i+j]);
98 fprintf(stderr,")\n");
102 printStdObject( StgClosure *obj, char* tag )
104 printStdObjHdr( obj, tag );
105 printStdObjPayload( obj );
109 printClosure( StgClosure *obj )
113 info = get_itbl(obj);
115 switch ( info->type ) {
117 barf("Invalid object");
119 disassemble( (StgBCO*)obj );
124 StgMutVar* mv = (StgMutVar*)obj;
125 fprintf(stderr,"MUT_VAR(var=%p, link=%p)\n", mv->var, mv->mut_link);
131 StgAP_STACK* ap = stgCast(StgAP_STACK*,obj);
133 fprintf(stderr,"AP_STACK("); printPtr((StgPtr)ap->fun);
134 for (i = 0; i < ap->size; ++i) {
135 fprintf(stderr,", ");
136 printPtr((P_)ap->payload[i]);
138 fprintf(stderr,")\n");
144 StgPAP* ap = stgCast(StgPAP*,obj);
146 fprintf(stderr,"AP("); printPtr((StgPtr)ap->fun);
147 for (i = 0; i < ap->n_args; ++i) {
148 fprintf(stderr,", ");
149 printPtr((P_)ap->payload[i]);
151 fprintf(stderr,")\n");
157 StgPAP* pap = stgCast(StgPAP*,obj);
159 fprintf(stderr,"PAP/%d(",pap->arity);
160 printPtr((StgPtr)pap->fun);
161 for (i = 0; i < pap->n_args; ++i) {
162 fprintf(stderr,", ");
163 printPtr((StgPtr)pap->payload[i]);
165 fprintf(stderr,")\n");
170 fprintf(stderr,"FOREIGN(");
171 printPtr((StgPtr)( ((StgForeignObj*)obj)->data ));
172 fprintf(stderr,")\n");
176 fprintf(stderr,"IND(");
177 printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
178 fprintf(stderr,")\n");
182 fprintf(stderr,"IND(");
183 printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
184 fprintf(stderr,")\n");
188 fprintf(stderr,"IND_STATIC(");
189 printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
190 fprintf(stderr,")\n");
194 fprintf(stderr,"IND_OLDGEN(");
195 printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
196 fprintf(stderr,")\n");
200 fprintf(stderr,"CAF_BH(");
201 printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
202 fprintf(stderr,")\n");
206 fprintf(stderr,"SE_BH\n");
209 case SE_CAF_BLACKHOLE:
210 fprintf(stderr,"SE_CAF_BH\n");
214 fprintf(stderr,"BH\n");
218 fprintf(stderr,"BQ(");
219 printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
220 fprintf(stderr,")\n");
224 fprintf(stderr,"TSO(");
225 fprintf(stderr,"%d (%p)",((StgTSO*)obj)->id, (StgTSO*)obj);
226 fprintf(stderr,")\n");
231 fprintf(stderr,"BLOCKED_FETCH(");
232 printGA(&(stgCast(StgBlockedFetch*,obj)->ga));
233 printPtr((StgPtr)(stgCast(StgBlockedFetch*,obj)->node));
234 fprintf(stderr,")\n");
238 fprintf(stderr,"FETCH_ME(");
239 printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
240 fprintf(stderr,")\n");
245 fprintf(stderr,"REMOTE_REF(");
246 printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
247 fprintf(stderr,")\n");
252 fprintf(stderr,"FETCH_ME_BQ(");
253 // printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
254 printPtr((StgPtr)stgCast(StgFetchMeBlockingQueue*,obj)->blocking_queue);
255 fprintf(stderr,")\n");
258 #if defined(GRAN) || defined(PAR)
260 fprintf(stderr,"RBH(");
261 printPtr((StgPtr)stgCast(StgRBH*,obj)->blocking_queue);
262 fprintf(stderr,")\n");
268 case CONSTR_1_0: case CONSTR_0_1:
269 case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
271 case CONSTR_CHARLIKE:
273 case CONSTR_NOCAF_STATIC:
275 /* We can't use printStdObject because we want to print the
280 fprintf(stderr,"%s(", info->prof.closure_desc);
281 fprintf(stderr,"%s", obj->header.prof.ccs->cc->label);
283 fprintf(stderr,"CONSTR(");
284 printPtr((StgPtr)obj->header.info);
285 fprintf(stderr,"(tag=%d)",info->srt_len);
287 for (i = 0; i < info->layout.payload.ptrs; ++i) {
288 fprintf(stderr,", ");
289 printPtr((StgPtr)obj->payload[i]);
291 for (j = 0; j < info->layout.payload.nptrs; ++j) {
292 fprintf(stderr,", %p#", obj->payload[i+j]);
294 fprintf(stderr,")\n");
299 /* rows are mutarrays in xmlambda, maybe we should make a new type: ROW */
300 case MUT_ARR_PTRS_FROZEN:
303 StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,obj);
305 fprintf(stderr,"Row<%i>(",p->ptrs);
306 for (i = 0; i < p->ptrs; ++i) {
307 if (i > 0) fprintf(stderr,", ");
308 printPtr((StgPtr)(p->payload[i]));
310 fprintf(stderr,")\n");
316 case FUN_1_0: case FUN_0_1:
317 case FUN_1_1: case FUN_0_2: case FUN_2_0:
319 fprintf(stderr,"FUN/%d(",itbl_to_fun_itbl(info)->arity);
320 printPtr((StgPtr)obj->header.info);
322 fprintf(stderr,", %s", obj->header.prof.ccs->cc->label);
324 printStdObjPayload(obj);
328 case THUNK_1_0: case THUNK_0_1:
329 case THUNK_1_1: case THUNK_0_2: case THUNK_2_0:
331 /* ToDo: will this work for THUNK_STATIC too? */
333 printStdObject(obj,info->prof.closure_desc);
335 printStdObject(obj,"THUNK");
340 printStdObjHdr(obj, "THUNK_SELECTOR");
341 fprintf(stderr, ", %p)\n", ((StgSelector *)obj)->selectee);
345 fprintf(stderr,"MUT_ARR_PTRS(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
347 case MUT_ARR_PTRS_FROZEN:
348 fprintf(stderr,"MUT_ARR_PTRS_FROZEN(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
354 fprintf(stderr,"ARR_WORDS(\"");
355 /* ToDo: we can't safely assume that this is a string!
356 for (i = 0; arrWordsGetChar(obj,i); ++i) {
357 putchar(arrWordsGetChar(obj,i));
359 for (i=0; i<((StgArrWords *)obj)->words; i++)
360 fprintf(stderr, "%u", ((StgArrWords *)obj)->payload[i]);
361 fprintf(stderr,"\")\n");
367 StgUpdateFrame* u = stgCast(StgUpdateFrame*,obj);
368 fprintf(stderr,"UPDATE_FRAME(");
369 printPtr((StgPtr)GET_INFO(u));
371 printPtr((StgPtr)u->updatee);
372 fprintf(stderr,")\n");
378 StgCatchFrame* u = stgCast(StgCatchFrame*,obj);
379 fprintf(stderr,"CATCH_FRAME(");
380 printPtr((StgPtr)GET_INFO(u));
382 printPtr((StgPtr)u->handler);
383 fprintf(stderr,")\n");
389 StgStopFrame* u = stgCast(StgStopFrame*,obj);
390 fprintf(stderr,"STOP_FRAME(");
391 printPtr((StgPtr)GET_INFO(u));
392 fprintf(stderr,")\n");
396 //barf("printClosure %d",get_itbl(obj)->type);
397 fprintf(stderr, "*** printClosure: unknown type %d ****\n",
398 get_itbl(obj)->type );
399 barf("printClosure %d",get_itbl(obj)->type);
405 void printGraph( StgClosure *obj )
412 printStackObj( StgPtr sp )
414 /*fprintf(stderr,"Stack[%d] = ", &stgStack[STACK_SIZE] - sp); */
416 StgClosure* c = (StgClosure*)(*sp);
417 printPtr((StgPtr)*sp);
418 if (c == (StgClosure*)&stg_ctoi_ret_R1p_info) {
419 fprintf(stderr, "\t\t\tstg_ctoi_ret_R1p_info\n" );
421 if (c == (StgClosure*)&stg_ctoi_ret_R1n_info) {
422 fprintf(stderr, "\t\t\tstg_ctoi_ret_R1n_info\n" );
424 if (c == (StgClosure*)&stg_ctoi_ret_F1_info) {
425 fprintf(stderr, "\t\t\tstg_ctoi_ret_F1_info\n" );
427 if (c == (StgClosure*)&stg_ctoi_ret_D1_info) {
428 fprintf(stderr, "\t\t\tstg_ctoi_ret_D1_info\n" );
430 if (c == (StgClosure*)&stg_ctoi_ret_V_info) {
431 fprintf(stderr, "\t\t\tstg_ctoi_ret_V_info\n" );
433 if (get_itbl(c)->type == BCO) {
434 fprintf(stderr, "\t\t\t");
435 fprintf(stderr, "BCO(...)\n");
438 fprintf(stderr, "\t\t\t");
439 printClosure ( (StgClosure*)(*sp));
448 printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
454 for(i = 0; i < size; i++, bitmap >>= 1 ) {
455 fprintf(stderr," stk[%d] (%p) = ", spBottom-(payload+i), payload+i);
456 if ((bitmap & 1) == 0) {
457 printPtr((P_)payload[i]);
458 fprintf(stderr,"\n");
460 fprintf(stderr,"Word# %d\n", payload[i]);
466 printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap, nat size )
472 for (bmp=0; i < size; bmp++) {
473 StgWord bitmap = large_bitmap->bitmap[bmp];
475 for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
476 fprintf(stderr," stk[%d] (%p) = ", spBottom-(payload+i), payload+i);
477 if ((bitmap & 1) == 0) {
478 printPtr((P_)payload[i]);
479 fprintf(stderr,"\n");
481 fprintf(stderr,"Word# %d\n", payload[i]);
488 printStackChunk( StgPtr sp, StgPtr spBottom )
491 const StgInfoTable *info;
493 ASSERT(sp <= spBottom);
494 for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
496 info = get_itbl((StgClosure *)sp);
498 switch (info->type) {
503 printObj((StgClosure*)sp);
515 fprintf(stderr, "RET_DYN (%p)\n", r);
517 p = (P_)(r->payload);
518 printSmallBitmap(spBottom, sp,
519 GET_LIVENESS(r->liveness), RET_DYN_SIZE);
522 for (size = GET_NONPTRS(dyn); size > 0; size--) {
523 fprintf(stderr," stk[%ld] (%p) = ", spBottom-p, p);
524 fprintf(stderr,"Word# %ld\n", *p);
528 for (size = GET_PTRS(dyn); size > 0; size--) {
529 fprintf(stderr," stk[%ld] (%p) = ", spBottom-p, p);
538 fprintf(stderr, "RET_SMALL (%p)\n", sp);
539 bitmap = info->layout.bitmap;
540 printSmallBitmap(spBottom, sp+1,
541 BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
547 bco = ((StgBCO *)sp[1]);
549 fprintf(stderr, "RET_BCO (%p)\n", sp);
550 printLargeBitmap(spBottom, sp+2,
551 BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
560 barf("printStackChunk");
565 void printTSO( StgTSO *tso )
567 printStackChunk( tso->sp, tso->stack+tso->stack_size);
570 /* -----------------------------------------------------------------------------
573 NOTE: must be kept in sync with the closure types in includes/ClosureTypes.h
574 -------------------------------------------------------------------------- */
576 static char *closure_type_names[] = {
587 "CONSTR_NOCAF_STATIC",
629 "MUT_ARR_PTRS_FROZEN",
646 info_type(StgClosure *closure){
647 return closure_type_names[get_itbl(closure)->type];
651 info_type_by_ip(StgInfoTable *ip){
652 return closure_type_names[ip->type];
656 info_hdr_type(StgClosure *closure, char *res){
657 strcpy(res,closure_type_names[get_itbl(closure)->type]);
660 /* --------------------------------------------------------------------------
661 * Address printing code
663 * Uses symbol table in (unstripped executable)
664 * ------------------------------------------------------------------------*/
666 /* --------------------------------------------------------------------------
667 * Simple lookup table
669 * Current implementation is pretty dumb!
670 * ------------------------------------------------------------------------*/
677 static nat table_size;
678 static struct entry* table;
681 static nat max_table_size;
683 static void reset_table( int size )
685 max_table_size = size;
687 table = (struct entry *)stgMallocBytes(size * sizeof(struct entry), "Printer.c:reset_table()");
690 static void prepare_table( void )
692 /* Could sort it... */
695 static void insert( unsigned value, const char *name )
697 if ( table_size >= max_table_size ) {
698 barf( "Symbol table overflow\n" );
700 table[table_size].value = value;
701 table[table_size].name = name;
702 table_size = table_size + 1;
707 static rtsBool lookup_name( char *name, unsigned *result )
710 for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) {
712 if (i < table_size) {
713 *result = table[i].value;
721 /* Code from somewhere inside GHC (circa 1994)
723 * "std"++xs -> "Zstd"++xs
724 * char_to_c 'Z' = "ZZ"
725 * char_to_c '&' = "Za"
726 * char_to_c '|' = "Zb"
727 * char_to_c ':' = "Zc"
728 * char_to_c '/' = "Zd"
729 * char_to_c '=' = "Ze"
730 * char_to_c '>' = "Zg"
731 * char_to_c '#' = "Zh"
732 * char_to_c '<' = "Zl"
733 * char_to_c '-' = "Zm"
734 * char_to_c '!' = "Zn"
735 * char_to_c '.' = "Zo"
736 * char_to_c '+' = "Zp"
737 * char_to_c '\'' = "Zq"
738 * char_to_c '*' = "Zt"
739 * char_to_c '_' = "Zu"
740 * char_to_c c = "Z" ++ show (ord c)
742 static char unZcode( char ch )
745 case 'a' : return ('&');
746 case 'b' : return ('|');
747 case 'c' : return (':');
748 case 'd' : return ('/');
749 case 'e' : return ('=');
750 case 'g' : return ('>');
751 case 'h' : return ('#');
752 case 'l' : return ('<');
753 case 'm' : return ('-');
754 case 'n' : return ('!');
755 case 'o' : return ('.');
756 case 'p' : return ('+');
757 case 'q' : return ('\'');
758 case 't' : return ('*');
759 case 'u' : return ('_');
761 case '\0' : return ('Z');
762 default : return (ch);
767 /* Precondition: out big enough to handle output (about twice length of in) */
768 static void enZcode( char *in, char *out )
774 for( i = 0; in[i] != '\0'; ++i ) {
849 const char *lookupGHCName( void *addr )
852 for( i = 0; i < table_size && table[i].value != (unsigned) addr; ++i ) {
854 if (i < table_size) {
855 return table[i].name;
861 static void printZcoded( const char *raw )
865 while ( raw[j] != '\0' ) {
867 fputc(unZcode(raw[j+1]),stderr);
870 fputc(raw[j],stderr);
876 /* --------------------------------------------------------------------------
877 * Symbol table loading
878 * ------------------------------------------------------------------------*/
880 /* Causing linking trouble on Win32 plats, so I'm
881 disabling this for now.
887 /* Fairly ad-hoc piece of code that seems to filter out a lot of
888 * rubbish like the obj-splitting symbols
891 static rtsBool isReal( flagword flags STG_UNUSED, const char *name )
894 /* ToDo: make this work on BFD */
895 int tp = type & N_TYPE;
896 if (tp == N_TEXT || tp == N_DATA) {
897 return (name[0] == '_' && name[1] != '_');
903 (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
904 (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
911 extern void DEBUG_LoadSymbols( char *name )
917 abfd = bfd_openr(name, "default");
919 barf("can't open executable %s to get symbol table", name);
921 if (!bfd_check_format_matches (abfd, bfd_object, &matching)) {
927 asymbol **symbol_table;
928 long number_of_symbols;
929 long num_real_syms = 0;
932 storage_needed = bfd_get_symtab_upper_bound (abfd);
934 if (storage_needed < 0) {
935 barf("can't read symbol table");
938 if (storage_needed == 0) {
939 belch("no storage needed");
942 symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
944 number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table);
946 if (number_of_symbols < 0) {
947 barf("can't canonicalise symbol table");
950 for( i = 0; i != number_of_symbols; ++i ) {
952 bfd_get_symbol_info(abfd,symbol_table[i],&info);
953 /*fprintf(stderr,"\t%c\t0x%x \t%s\n",info.type,(nat)info.value,info.name); */
954 if (isReal(info.type, info.name)) {
959 IF_DEBUG(interpreter,
960 fprintf(stderr,"Loaded %ld symbols. Of which %ld are real symbols\n",
961 number_of_symbols, num_real_syms)
964 reset_table( num_real_syms );
966 for( i = 0; i != number_of_symbols; ++i ) {
968 bfd_get_symbol_info(abfd,symbol_table[i],&info);
969 if (isReal(info.type, info.name)) {
970 insert( info.value, info.name );
974 stgFree(symbol_table);
979 #else /* HAVE_BFD_H */
981 extern void DEBUG_LoadSymbols( char *name STG_UNUSED )
986 #endif /* HAVE_BFD_H */
988 #include "StoragePriv.h"
990 void findPtr(P_ p, int); /* keep gcc -Wall happy */
993 findPtr(P_ p, int follow)
998 const int arr_size = 1024;
999 StgPtr arr[arr_size];
1002 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1003 for (s = 0; s < generations[g].n_steps; s++) {
1004 if (RtsFlags.GcFlags.generations == 1) {
1005 bd = generations[g].steps[s].to_blocks;
1007 bd = generations[g].steps[s].blocks;
1009 for (; bd; bd = bd->link) {
1010 for (q = bd->start; q < bd->free; q++) {
1014 while (!LOOKS_LIKE_INFO_PTR(*r) || (P_)*r == NULL) {
1017 fprintf(stderr, "%p = ", r);
1018 printClosure((StgClosure *)r);
1028 if (follow && i == 1) {
1029 fprintf(stderr, "-->\n");
1035 void printPtr( StgPtr p )
1037 fprintf(stderr, "ptr 0x%p (enable -DDEBUG for more info) " , p );
1040 void printObj( StgClosure *obj )
1042 fprintf(stderr, "obj 0x%p (enable -DDEBUG for more info) " , obj );