/*----------------------------------------------------------------------- The Lazy Virtual Machine. Daan Leijen. Copyright 2001, Daan Leijen. All rights reserved. This file is distributed under the terms of the GNU Library General Public License. -----------------------------------------------------------------------*/ /* $Id: print.c 127 2002-07-25 22:06:02Z cvs-3 $ */ #include "mlvalues.h" #include "memory.h" #include "module.h" #include "instr.h" #include "print.h" #include "thread.h" const char* String_of_size( wsize_t size, const char* mod ) { static char buf[MAXSTR]; if (size < Kilo) snprintf( buf, MAXSTR, "%lu%s", size, mod ); else if (size < Mega) snprintf( buf, MAXSTR, "%lu%c%s", size / Kilo, 'k', mod ); else if (size < 10*Mega && ((size % Mega) / (Kilo*(Kilo/10)) != 0)) snprintf( buf, MAXSTR, "%lu.%lu%c%s", size / Mega, (size % Mega) / (Kilo*(Kilo/10)), 'm', mod ); else if (size < Giga) snprintf( buf, MAXSTR, "%lu%c%s", size / Mega, 'm', mod ); else if ((size % Giga) / (Mega*(Kilo/10)) != 0) snprintf( buf, MAXSTR, "%lu.%lu%c%s", size / Giga, (size % Giga) / (Mega*(Kilo/10)), 'g', mod ); else snprintf( buf, MAXSTR, "%lu%c%s", size / Giga, 'g', mod ); return buf; } void FUN_VAR_ARGS1( print, const char*, msg, args ) { vmessage(msg,args); } END_ARGS(args); #define Max_level 4 static void _print_value( int level, value module, value v ); static void _print_block( int level, const char* name, value module, value v ) { wsize_t i; if (level > Max_level) { print("..."); return; } print( "[%s", name ); for( i = 0; i < Wosize_val(v); i++ ) { print( " " ); _print_value( level+1, module, Field(v,i) ); } print( "]" ); } static void _print_value( int level, value module, value v ) { if (level > Max_level) { print( "..."); return; } if (v == 0) { print( "[inv]" ); } else if (Is_long(v)) { print( "[int %li]", Long_val(v) ); } else if (Is_atom(v)) { print( "[atom %li]", Tag_val(v) ); } else if (is_heap_val(v)) { switch (Tag_val(v)) { case String_tag: print( "[string \"%s\"]", String_val(v)); break; case Ap_tag: _print_block( level, "ap", module, v ); break; case Code_tag: print( "%s", find_name_of_code( module, v )); break; case Nap_tag: _print_block( level, "nap", module, v ); break; case Ind_tag: _print_block( level, "ind", module, v ); break; case Caf_tag: print( "[caf %s]", find_name_of_code( module, v )); break; case Inv_tag: print( "[blackhole]" ); break; case Suspend_tag:print( "[suspension]" ); break; case Double_tag: print( "[float %g]", Double_val(v) ); break; default : if (Wosize_val(v) <= 4) { char buf[16]; snprintf( buf, 16, "tag %i", Tag_val(v) ); _print_block( level, buf, module, v ); } else print( "[block size=%li tag=%li]", Wosize_val(v), Tag_val(v) ); break; } } else if (is_code_val(module,v)) { print( "%s", find_name_of_code(module,v)); } else { print( "[ptr 0x%lx]", v ); } } void print_value( value module, value v ) { _print_value( 0, module, v ); } void print_block( const char* name, value module, value v ) { _print_block( 0, name, module, v ); } void print_instr( value module, value* sp, opcode_t* code ) { switch (instr_arg_count( code[0] )) { case 2 : print( "%-10s %-4li %-4li", instr_name(code[0]), code[1], code[2] ); break; case 1 : print( "%-10s %-8li", instr_name(code[0]), code[1] ); break; default: print( "%-10s ", instr_name(code[0]) ); break; } switch (code[0]) { case PUSHCODE: print( " -- %s", find_name_of_code( module, Val_fixup(code[1]) ) ); break; case ENTERCODE: print( " -- %s", find_name_of_code( module, Val_fixup(code[1]) ) ); break; case PUSHCONT: print( " -- %s", find_name_of_code( module, Val_code(code + code[1]) ) ); break; case PUSHVAR: print( " -- " ); print_value( module, sp[code[1]] ); break; case PUSHVAR0: print( " -- " ); print_value( module, sp[0] ); break; case PUSHVAR1: print( " -- " ); print_value( module, sp[1] ); break; case PUSHVAR2: print( " -- " ); print_value( module, sp[2] ); break; case PUSHVAR3: print( " -- " ); print_value( module, sp[3] ); break; case PUSHVAR4: print( " -- " ); print_value( module, sp[4] ); break; case PUSHINT: print( " -- " ); print_value( module, Val_long(code[1]) ); break; case TESTINT: print( " -- " ); print_value( module, Val_long(code[1]) ); break; case EVALVAR: print( " -- " ); print_value( module, sp[code[1]] ); break; case PACK: print( " -- %i", code[1] ); print_value( module, sp[code[2]] ); break; case MATCH: case SWITCHCON: case MATCHCON: case MATCHINT: print( " -- " ); print_value( module, sp[0] ); break; } print( "\n" ); } /*---------------------------------------------------------------------- debug dump of the stack ----------------------------------------------------------------------*/ void print_stack( value module, const value* sp, const value* fp ) { long local; Assert( fp >= sp ); local = 0; while(1) { while (fp > sp) { print( "%4i -- ", local ); print_value( module, sp[0] ); print( "\n" ); sp++; local++; } switch( Frame_frame(fp) ) { case frame_cont: print( "continuation" ); break; case frame_update: print( "update" ); break; case frame_catch: print( "catch" ); break; case frame_stop: print( "stop\n" ); return; default: print( "unknown frame!" ); return; } print( " -- " ); print_value( module, Frame_value(fp) ); print( "\n" ); local += Frame_size; sp += Frame_size; fp = Frame_next(fp); } } /*---------------------------------------------------------------------- supposedly nice trace of the stack but still quite rough since Caf's and Update's are overwritten by the exception so we lose the trace ----------------------------------------------------------------------*/ void print_stack_trace( value module, const value* fp, int max_trace ) { #define Max_trace 5 value vs[Max_trace]; /* bottom traces */ value ws[Max_trace]; /* top traces */ int trace_count; int trace_total; int i; /* find the traces on the stack */ trace_count = 0; trace_total = 0; while(Frame_frame(fp) != frame_stop) { switch (Frame_frame(fp)) { case frame_cont: trace_total++; /* are we in the bottom traces */ if (trace_count < Max_trace) { vs[trace_count] = Frame_value(fp); trace_count++; } /* are we in the top traces */ else if (trace_count < (Max_trace*2)) { ws[trace_count-Max_trace] = Frame_value(fp); trace_count++; } /* the top traces are filled, shift one out to put a new one in */ else { for( i = Max_trace-1; i > 0; i-- ) ws[i-1] = ws[i]; ws[trace_count-Max_trace-1] = Frame_value(fp); } break; default: break; } fp = Frame_next(fp); } /* print the traces */ if (trace_count == 0) return; print( "\ntrace:\n" ); for( i = 0; i < trace_count && i < Max_trace; i++) { print( " demanded from \"" ); print_value( module, vs[i] ); print("\"\n"); } if (trace_count <= Max_trace) return; if (trace_total > Max_trace*2) print( " ...\n" ); for( i = 0; i < (trace_count - Max_trace) && i < Max_trace; i++) { print( " demanded from \"" ); print_value( module, ws[i] ); print("\"\n"); } return; }