1 /* -----------------------------------------------------------------------------
2 * $Id: Printer.c,v 1.60 2003/05/14 09:13:59 simonmar 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");
120 case CONSTR_1_0: case CONSTR_0_1:
121 case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
123 case CONSTR_CHARLIKE:
125 case CONSTR_NOCAF_STATIC:
127 /* We can't use printStdObject because we want to print the
132 fprintf(stderr,"%s(", info->prof.closure_desc);
133 fprintf(stderr,"%s", obj->header.prof.ccs->cc->label);
135 fprintf(stderr,"CONSTR(");
136 printPtr((StgPtr)obj->header.info);
137 fprintf(stderr,"(tag=%d)",info->srt_bitmap);
139 for (i = 0; i < info->layout.payload.ptrs; ++i) {
140 fprintf(stderr,", ");
141 printPtr((StgPtr)obj->payload[i]);
143 for (j = 0; j < info->layout.payload.nptrs; ++j) {
144 fprintf(stderr,", %p#", obj->payload[i+j]);
146 fprintf(stderr,")\n");
151 case FUN_1_0: case FUN_0_1:
152 case FUN_1_1: case FUN_0_2: case FUN_2_0:
154 fprintf(stderr,"FUN/%d(",itbl_to_fun_itbl(info)->arity);
155 printPtr((StgPtr)obj->header.info);
157 fprintf(stderr,", %s", obj->header.prof.ccs->cc->label);
159 printStdObjPayload(obj);
163 case THUNK_1_0: case THUNK_0_1:
164 case THUNK_1_1: case THUNK_0_2: case THUNK_2_0:
166 /* ToDo: will this work for THUNK_STATIC too? */
168 printStdObject(obj,info->prof.closure_desc);
170 printStdObject(obj,"THUNK");
175 printStdObjHdr(obj, "THUNK_SELECTOR");
176 fprintf(stderr, ", %p)\n", ((StgSelector *)obj)->selectee);
180 disassemble( (StgBCO*)obj );
185 StgPAP* ap = stgCast(StgPAP*,obj);
187 fprintf(stderr,"AP("); printPtr((StgPtr)ap->fun);
188 for (i = 0; i < ap->n_args; ++i) {
189 fprintf(stderr,", ");
190 printPtr((P_)ap->payload[i]);
192 fprintf(stderr,")\n");
198 StgPAP* pap = stgCast(StgPAP*,obj);
200 fprintf(stderr,"PAP/%d(",pap->arity);
201 printPtr((StgPtr)pap->fun);
202 for (i = 0; i < pap->n_args; ++i) {
203 fprintf(stderr,", ");
204 printPtr((StgPtr)pap->payload[i]);
206 fprintf(stderr,")\n");
212 StgAP_STACK* ap = stgCast(StgAP_STACK*,obj);
214 fprintf(stderr,"AP_STACK("); printPtr((StgPtr)ap->fun);
215 for (i = 0; i < ap->size; ++i) {
216 fprintf(stderr,", ");
217 printPtr((P_)ap->payload[i]);
219 fprintf(stderr,")\n");
224 fprintf(stderr,"IND(");
225 printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
226 fprintf(stderr,")\n");
230 fprintf(stderr,"IND_OLDGEN(");
231 printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
232 fprintf(stderr,")\n");
236 fprintf(stderr,"IND(");
237 printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
238 fprintf(stderr,")\n");
241 case IND_OLDGEN_PERM:
242 fprintf(stderr,"IND_OLDGEN_PERM(");
243 printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
244 fprintf(stderr,")\n");
248 fprintf(stderr,"IND_STATIC(");
249 printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
250 fprintf(stderr,")\n");
253 /* Cannot happen -- use default case.
265 StgUpdateFrame* u = stgCast(StgUpdateFrame*,obj);
266 fprintf(stderr,"UPDATE_FRAME(");
267 printPtr((StgPtr)GET_INFO(u));
269 printPtr((StgPtr)u->updatee);
270 fprintf(stderr,")\n");
276 StgCatchFrame* u = stgCast(StgCatchFrame*,obj);
277 fprintf(stderr,"CATCH_FRAME(");
278 printPtr((StgPtr)GET_INFO(u));
280 printPtr((StgPtr)u->handler);
281 fprintf(stderr,")\n");
287 StgStopFrame* u = stgCast(StgStopFrame*,obj);
288 fprintf(stderr,"STOP_FRAME(");
289 printPtr((StgPtr)GET_INFO(u));
290 fprintf(stderr,")\n");
295 fprintf(stderr,"CAF_BH(");
296 printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
297 fprintf(stderr,")\n");
301 fprintf(stderr,"BH\n");
305 fprintf(stderr,"BQ(");
306 printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
307 fprintf(stderr,")\n");
311 fprintf(stderr,"SE_BH\n");
314 case SE_CAF_BLACKHOLE:
315 fprintf(stderr,"SE_CAF_BH\n");
321 fprintf(stderr,"ARR_WORDS(\"");
322 /* ToDo: we can't safely assume that this is a string!
323 for (i = 0; arrWordsGetChar(obj,i); ++i) {
324 putchar(arrWordsGetChar(obj,i));
326 for (i=0; i<((StgArrWords *)obj)->words; i++)
327 fprintf(stderr, "%u", ((StgArrWords *)obj)->payload[i]);
328 fprintf(stderr,"\")\n");
333 fprintf(stderr,"MUT_ARR_PTRS(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
336 case MUT_ARR_PTRS_FROZEN:
337 #if !defined(XMLAMBDA)
338 fprintf(stderr,"MUT_ARR_PTRS_FROZEN(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
342 /* rows are mutarrays in xmlambda, maybe we should make a new type: ROW */
344 StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,obj);
346 fprintf(stderr,"Row<%i>(",p->ptrs);
347 for (i = 0; i < p->ptrs; ++i) {
348 if (i > 0) fprintf(stderr,", ");
349 printPtr((StgPtr)(p->payload[i]));
351 fprintf(stderr,")\n");
358 StgMutVar* mv = (StgMutVar*)obj;
359 fprintf(stderr,"MUT_VAR(var=%p, link=%p)\n", mv->var, mv->mut_link);
364 fprintf(stderr,"WEAK(");
365 fprintf(stderr," key=%p value=%p finalizer=%p",
366 (StgPtr)(((StgWeak*)obj)->key),
367 (StgPtr)(((StgWeak*)obj)->value),
368 (StgPtr)(((StgWeak*)obj)->finalizer));
369 fprintf(stderr,")\n");
370 /* ToDo: chase 'link' ? */
374 fprintf(stderr,"FOREIGN(");
375 printPtr((StgPtr)( ((StgForeignObj*)obj)->data ));
376 fprintf(stderr,")\n");
380 fprintf(stderr,"STABLE_NAME(%d)\n", ((StgStableName*)obj)->sn);
384 fprintf(stderr,"TSO(");
385 fprintf(stderr,"%d (%p)",((StgTSO*)obj)->id, (StgTSO*)obj);
386 fprintf(stderr,")\n");
391 fprintf(stderr,"BLOCKED_FETCH(");
392 printGA(&(stgCast(StgBlockedFetch*,obj)->ga));
393 printPtr((StgPtr)(stgCast(StgBlockedFetch*,obj)->node));
394 fprintf(stderr,")\n");
398 fprintf(stderr,"FETCH_ME(");
399 printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
400 fprintf(stderr,")\n");
404 fprintf(stderr,"FETCH_ME_BQ(");
405 // printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
406 printPtr((StgPtr)stgCast(StgFetchMeBlockingQueue*,obj)->blocking_queue);
407 fprintf(stderr,")\n");
411 #if defined(GRAN) || defined(PAR)
413 fprintf(stderr,"RBH(");
414 printPtr((StgPtr)stgCast(StgRBH*,obj)->blocking_queue);
415 fprintf(stderr,")\n");
421 /* Symptomatic of a problem elsewhere, have it fall-through & fail */
423 fprintf(stderr,"EVACUATED(");
424 printClosure((StgEvacuated*)obj->evacuee);
425 fprintf(stderr,")\n");
429 #if defined(PAR) && defined(DIST)
431 fprintf(stderr,"REMOTE_REF(");
432 printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
433 fprintf(stderr,")\n");
438 //barf("printClosure %d",get_itbl(obj)->type);
439 fprintf(stderr, "*** printClosure: unknown type %d ****\n",
440 get_itbl(obj)->type );
441 barf("printClosure %d",get_itbl(obj)->type);
447 void printGraph( StgClosure *obj )
454 printStackObj( StgPtr sp )
456 /*fprintf(stderr,"Stack[%d] = ", &stgStack[STACK_SIZE] - sp); */
458 StgClosure* c = (StgClosure*)(*sp);
459 printPtr((StgPtr)*sp);
460 if (c == (StgClosure*)&stg_ctoi_ret_R1p_info) {
461 fprintf(stderr, "\t\t\tstg_ctoi_ret_R1p_info\n" );
463 if (c == (StgClosure*)&stg_ctoi_ret_R1n_info) {
464 fprintf(stderr, "\t\t\tstg_ctoi_ret_R1n_info\n" );
466 if (c == (StgClosure*)&stg_ctoi_ret_F1_info) {
467 fprintf(stderr, "\t\t\tstg_ctoi_ret_F1_info\n" );
469 if (c == (StgClosure*)&stg_ctoi_ret_D1_info) {
470 fprintf(stderr, "\t\t\tstg_ctoi_ret_D1_info\n" );
472 if (c == (StgClosure*)&stg_ctoi_ret_V_info) {
473 fprintf(stderr, "\t\t\tstg_ctoi_ret_V_info\n" );
475 if (get_itbl(c)->type == BCO) {
476 fprintf(stderr, "\t\t\t");
477 fprintf(stderr, "BCO(...)\n");
480 fprintf(stderr, "\t\t\t");
481 printClosure ( (StgClosure*)(*sp));
490 printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
496 for(i = 0; i < size; i++, bitmap >>= 1 ) {
497 fprintf(stderr," stk[%d] (%p) = ", spBottom-(payload+i), payload+i);
498 if ((bitmap & 1) == 0) {
499 printPtr((P_)payload[i]);
500 fprintf(stderr,"\n");
502 fprintf(stderr,"Word# %d\n", payload[i]);
508 printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap, nat size )
514 for (bmp=0; i < size; bmp++) {
515 StgWord bitmap = large_bitmap->bitmap[bmp];
517 for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
518 fprintf(stderr," stk[%d] (%p) = ", spBottom-(payload+i), payload+i);
519 if ((bitmap & 1) == 0) {
520 printPtr((P_)payload[i]);
521 fprintf(stderr,"\n");
523 fprintf(stderr,"Word# %d\n", payload[i]);
530 printStackChunk( StgPtr sp, StgPtr spBottom )
533 const StgInfoTable *info;
535 ASSERT(sp <= spBottom);
536 for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
538 info = get_itbl((StgClosure *)sp);
540 switch (info->type) {
545 printObj((StgClosure*)sp);
557 fprintf(stderr, "RET_DYN (%p)\n", r);
559 p = (P_)(r->payload);
560 printSmallBitmap(spBottom, sp,
561 GET_LIVENESS(r->liveness), RET_DYN_BITMAP_SIZE);
562 p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE;
564 for (size = GET_NONPTRS(dyn); size > 0; size--) {
565 fprintf(stderr," stk[%ld] (%p) = ", (long)(spBottom-p), p);
566 fprintf(stderr,"Word# %ld\n", (long)*p);
570 for (size = GET_PTRS(dyn); size > 0; size--) {
571 fprintf(stderr," stk[%ld] (%p) = ", (long)(spBottom-p), p);
580 fprintf(stderr, "RET_SMALL (%p)\n", sp);
581 bitmap = info->layout.bitmap;
582 printSmallBitmap(spBottom, sp+1,
583 BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
589 bco = ((StgBCO *)sp[1]);
591 fprintf(stderr, "RET_BCO (%p)\n", sp);
592 printLargeBitmap(spBottom, sp+2,
593 BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
602 barf("printStackChunk");
607 void printTSO( StgTSO *tso )
609 printStackChunk( tso->sp, tso->stack+tso->stack_size);
612 /* -----------------------------------------------------------------------------
615 NOTE: must be kept in sync with the closure types in includes/ClosureTypes.h
616 -------------------------------------------------------------------------- */
618 static char *closure_type_names[] = {
629 "CONSTR_NOCAF_STATIC",
672 "MUT_ARR_PTRS_FROZEN",
689 info_type(StgClosure *closure){
690 return closure_type_names[get_itbl(closure)->type];
694 info_type_by_ip(StgInfoTable *ip){
695 return closure_type_names[ip->type];
699 info_hdr_type(StgClosure *closure, char *res){
700 strcpy(res,closure_type_names[get_itbl(closure)->type]);
703 /* --------------------------------------------------------------------------
704 * Address printing code
706 * Uses symbol table in (unstripped executable)
707 * ------------------------------------------------------------------------*/
709 /* --------------------------------------------------------------------------
710 * Simple lookup table
712 * Current implementation is pretty dumb!
713 * ------------------------------------------------------------------------*/
720 static nat table_size;
721 static struct entry* table;
724 static nat max_table_size;
726 static void reset_table( int size )
728 max_table_size = size;
730 table = (struct entry *)stgMallocBytes(size * sizeof(struct entry), "Printer.c:reset_table()");
733 static void prepare_table( void )
735 /* Could sort it... */
738 static void insert( unsigned value, const char *name )
740 if ( table_size >= max_table_size ) {
741 barf( "Symbol table overflow\n" );
743 table[table_size].value = value;
744 table[table_size].name = name;
745 table_size = table_size + 1;
750 static rtsBool lookup_name( char *name, unsigned *result )
753 for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) {
755 if (i < table_size) {
756 *result = table[i].value;
764 /* Code from somewhere inside GHC (circa 1994)
766 * "std"++xs -> "Zstd"++xs
767 * char_to_c 'Z' = "ZZ"
768 * char_to_c '&' = "Za"
769 * char_to_c '|' = "Zb"
770 * char_to_c ':' = "Zc"
771 * char_to_c '/' = "Zd"
772 * char_to_c '=' = "Ze"
773 * char_to_c '>' = "Zg"
774 * char_to_c '#' = "Zh"
775 * char_to_c '<' = "Zl"
776 * char_to_c '-' = "Zm"
777 * char_to_c '!' = "Zn"
778 * char_to_c '.' = "Zo"
779 * char_to_c '+' = "Zp"
780 * char_to_c '\'' = "Zq"
781 * char_to_c '*' = "Zt"
782 * char_to_c '_' = "Zu"
783 * char_to_c c = "Z" ++ show (ord c)
785 static char unZcode( char ch )
788 case 'a' : return ('&');
789 case 'b' : return ('|');
790 case 'c' : return (':');
791 case 'd' : return ('/');
792 case 'e' : return ('=');
793 case 'g' : return ('>');
794 case 'h' : return ('#');
795 case 'l' : return ('<');
796 case 'm' : return ('-');
797 case 'n' : return ('!');
798 case 'o' : return ('.');
799 case 'p' : return ('+');
800 case 'q' : return ('\'');
801 case 't' : return ('*');
802 case 'u' : return ('_');
804 case '\0' : return ('Z');
805 default : return (ch);
810 /* Precondition: out big enough to handle output (about twice length of in) */
811 static void enZcode( char *in, char *out )
817 for( i = 0; in[i] != '\0'; ++i ) {
892 const char *lookupGHCName( void *addr )
895 for( i = 0; i < table_size && table[i].value != (unsigned) addr; ++i ) {
897 if (i < table_size) {
898 return table[i].name;
904 static void printZcoded( const char *raw )
908 while ( raw[j] != '\0' ) {
910 fputc(unZcode(raw[j+1]),stderr);
913 fputc(raw[j],stderr);
919 /* --------------------------------------------------------------------------
920 * Symbol table loading
921 * ------------------------------------------------------------------------*/
923 /* Causing linking trouble on Win32 plats, so I'm
924 disabling this for now.
930 /* Fairly ad-hoc piece of code that seems to filter out a lot of
931 * rubbish like the obj-splitting symbols
934 static rtsBool isReal( flagword flags STG_UNUSED, const char *name )
937 /* ToDo: make this work on BFD */
938 int tp = type & N_TYPE;
939 if (tp == N_TEXT || tp == N_DATA) {
940 return (name[0] == '_' && name[1] != '_');
946 (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
947 (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
954 extern void DEBUG_LoadSymbols( char *name )
960 abfd = bfd_openr(name, "default");
962 barf("can't open executable %s to get symbol table", name);
964 if (!bfd_check_format_matches (abfd, bfd_object, &matching)) {
970 asymbol **symbol_table;
971 long number_of_symbols;
972 long num_real_syms = 0;
975 storage_needed = bfd_get_symtab_upper_bound (abfd);
977 if (storage_needed < 0) {
978 barf("can't read symbol table");
981 if (storage_needed == 0) {
982 belch("no storage needed");
985 symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
987 number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table);
989 if (number_of_symbols < 0) {
990 barf("can't canonicalise symbol table");
993 for( i = 0; i != number_of_symbols; ++i ) {
995 bfd_get_symbol_info(abfd,symbol_table[i],&info);
996 /*fprintf(stderr,"\t%c\t0x%x \t%s\n",info.type,(nat)info.value,info.name); */
997 if (isReal(info.type, info.name)) {
1002 IF_DEBUG(interpreter,
1003 fprintf(stderr,"Loaded %ld symbols. Of which %ld are real symbols\n",
1004 number_of_symbols, num_real_syms)
1007 reset_table( num_real_syms );
1009 for( i = 0; i != number_of_symbols; ++i ) {
1011 bfd_get_symbol_info(abfd,symbol_table[i],&info);
1012 if (isReal(info.type, info.name)) {
1013 insert( info.value, info.name );
1017 stgFree(symbol_table);
1022 #else /* HAVE_BFD_H */
1024 extern void DEBUG_LoadSymbols( char *name STG_UNUSED )
1029 #endif /* HAVE_BFD_H */
1031 #include "StoragePriv.h"
1033 void findPtr(P_ p, int); /* keep gcc -Wall happy */
1036 findPtr(P_ p, int follow)
1041 const int arr_size = 1024;
1042 StgPtr arr[arr_size];
1045 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1046 for (s = 0; s < generations[g].n_steps; s++) {
1047 if (RtsFlags.GcFlags.generations == 1) {
1048 bd = generations[g].steps[s].to_blocks;
1050 bd = generations[g].steps[s].blocks;
1052 for (; bd; bd = bd->link) {
1053 for (q = bd->start; q < bd->free; q++) {
1057 while (!LOOKS_LIKE_INFO_PTR(*r) || (P_)*r == NULL) {
1060 fprintf(stderr, "%p = ", r);
1061 printClosure((StgClosure *)r);
1071 if (follow && i == 1) {
1072 fprintf(stderr, "-->\n");
1078 void printPtr( StgPtr p )
1080 fprintf(stderr, "ptr 0x%p (enable -DDEBUG for more info) " , p );
1083 void printObj( StgClosure *obj )
1085 fprintf(stderr, "obj 0x%p (enable -DDEBUG for more info) " , obj );