/*------------------------->  ANSI C - sourcefile  <-------------------------*/
/* Copyright (C) 1995 by International Computer Science Institute            */
/* This file is part of the GNU Sather library. It is free software; you may */
/* redistribute  and/or modify it under the terms of the GNU Library General */
/* Public  License (LGPL)  as published  by the  Free  Software  Foundation; */
/* either version 2 of the license, or (at your option) any later version.   */
/* This  library  is distributed  in the  hope that it will  be  useful, but */
/* WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY */
/* or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       */
/* The license text is also available from:  Free Software Foundation, Inc., */
/* 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     */
/*------------>  Please email comments to <bug-sather@gnu.org>  <------------*/


/*
 * This file defines all the C routines used by the class PO. It uses
 * type tables generated by the Sather compiler to print out various
 * informations about objects and stack frames.
 *
 * V 1.0 , Jan 1996, by Claudio Fleiner
 */


#include "sather.h"
#include "tags.h"
#include <stdio.h>
#include <signal.h> 
/*#include <varargs.h>*/
#include <stdarg.h>
#include <setjmp.h>

#ifndef PRINT_BACKTRACE
struct sather_function_definition *sather_functions[];
#endif

static jmp_buf signal_jump;
static int signal_buffer_set = 0;
static void print_signal_handler();
#define ON_SIGNAL	{ void *signal_sigsev,*signal_sigbus; \
			  if(signal_buffer_set++==0?setjmp(signal_jump)==0:1) { \
				if(signal_buffer_set==1) { \
				   signal_sigsev=signal(SIGSEGV,print_signal_handler); \
				   signal_sigbus=signal(SIGBUS,print_signal_handler); \
				}

#define ON_SIGNAL_DO      } else { \
				signal(SIGSEGV,signal_sigsev); \
				signal(SIGBUS,signal_sigbus);

#define ON_SIGNAL_END     } \
			  if(signal_buffer_set--==1) { \
			    signal(SIGSEGV,signal_sigsev); \
			    signal(SIGBUS,signal_sigbus); \
			  } \
			}

#define PO_ARG		 0
#define PO_LOCAL	 1
#define PO_ATTR		 2
#define PO_TITLE	 3
#define PO_FUNC		 4
#define PO_ARRAY	 5
#define PO_NAME_MASK	 7

#define PO_INT		 (0*8)
#define PO_BOOL		 (1*8)
#define PO_CHAR		 (2*8)
#define PO_FLT		 (3*8)
#define PO_FLTD		 (4*8)
#define PO_STR		 (5*8)
#define PO_FSTR		 (6*8)
#define PO_REF		 (7*8)
#define PO_THREAD_ID	 (8*8)
#define PO_VAL		 (9*8)
#define PO_BND_ROUT	 (10*8)
#define PO_EXTERN	 (11*8)
#define PO_EXT_OB	 (12*8)
#define PO_TYPE_MASK	 (15*8)

#define PO_ABSTRACT	 256

#define FRAME_COLOR               "black"
#define OUT_OF_BAND_COLOR         "red" 
/* Attributes */
#define PO_VAL_ARGATTR_COLOR      "darkslateblue"
#define PO_REF_ARGATTR_COLOR      "blue"
#define PO_BLT_ARGATTR_COLOR      "royalblue" 
/* Locals */
#define PO_VAL_LOCAL_COLOR        "mediumvioletred"
#define PO_REF_LOCAL_COLOR        "magenta"
#define PO_BLT_LOCAL_COLOR        "purple"


#define PRINT_SID_SIZE 	  10
#define PRINT_VALUE_SIZE 140
#define PRINT_GDB_SIZE    20
#define PRINT_GID_SIZE    30
#define PRINT_TYPE_SIZE    3
#define PRINT_AS_INDEX    10
#define PRINT_AC_INDEX    18
typedef char print_SID_t[ PRINT_SID_SIZE ];
typedef char print_VALUE_t[ PRINT_VALUE_SIZE ];
typedef char print_GDB_t[ PRINT_GDB_SIZE ];
typedef char print_GID_t[ PRINT_GID_SIZE ];
typedef char print_TYPE_t[ PRINT_TYPE_SIZE ];
typedef char print_as_index_t[ PRINT_AS_INDEX ];
typedef char print_ac_index_t[ PRINT_AC_INDEX ];

#ifdef PSATHER
#define SID F_SYSID
#else
#define SID(x) (((unsigned long)x)>>3)
#endif

/*static void Pr();*/
static void Pr( char *fmt, ... );
static void FUNC( struct _func_frame *f ) ;
void PO( OB ob );
void POG( OB ob );
void print_object( OB ob );	/* Synonym for PO */
void view_object( OB ob );	/* Synonym for POG */
static void print_Type( OB ob, int tg );
static void print_VType( OB ob, int tg, int w );
static void print_Func( struct _func_frame *f, int where );

/* is not defined as a builtin type */
typedef struct FSTR_struct
{ /* layout for FSTR */
	OB_HEADER header;
	INT loc;
	INT asize;
	CHAR arr_part[ 1 ];
}
*FSTR;

struct _func_frame FF;


int print_depth = 1;
int print_lines = 15;
int print_func = 20;
int print_str_len = 80;
int print_index = 10;
int print_attr = 1;
int print_type = 0;
int print_real = 1;
int print_c_attr = 0;
int print_c_type = 0;
int print_c_real = 0;
int print_void = 0;
int print_id = 1;
int print_pointer = 0;
int print_gdb = 1;
int print_declared_source = 1;
int print_class_source = 0;
int print_short_source = 1;
int print_orig_depth = 1;
int print_need_indent = 1;
int print_in_pog = 0;

static int print_start_line;
static int print_current_line;
static int print_last_line;
static int print_str = 0;
/*
 * NUM_OF_ATTR is supposed to be defined in the file that
 * includes this one, and is the maximum number of attributes 
 * a class has.
 */
static int print_num_of_attr = 0;
static int print_num_of_index = 0;

static char **print_st = NULL;
static char **print_ct = NULL;
static char **print_sa = NULL;
static char **print_ca = NULL;
static char **print_sr = NULL;
static char **print_cr = NULL;
static char **print_nm = NULL;
static print_SID_t *print_SID = NULL;
static print_VALUE_t *print_VALUE = NULL;
static print_GDB_t *print_GDB = NULL;
static print_GID_t *print_GID = NULL;
static unsigned long *print_TYPE = NULL;
static print_as_index_t *print_as_index = NULL;
static print_ac_index_t *print_ac_index = NULL;
static void *get_remote_object( void *p, int where, int t, int boxed );

#ifdef STR_tag
static STR str_buf;
static char *cur_str_pos;
#endif



#ifdef PSATHER
#define GET_TAG F_TAG
#define VD(o) FVOID(o)
#else
#define GET_TAG(x) (((OB)x)->header.tag)
#define VD(o) ((o)==NULL)
#endif

static void print_signal_handler()
{
	longjmp( signal_jump, 1 );
}

/*
 * some handy functions
 * Most of them could be defined as macro, but
 * a macro cannot be called from GDB.
 */

/*
 * returns the Sather function string of a function index
 * (the function index is defined while compiling a sather
 * program. Each function gets another id)
 */
static char *_print_FUNC( int id )
{
	return sather_functions[ id ] ->sather_name;
}
/*
 * this function is supposed to return the source file
 * and line for a function. does not work yet.
 */
static char *_print_FUNCP( int id )
{
	return "";
}


/*
 * returns the c function name of a function index
 */
static char *_print_FUNCC( int id )
{
	return sather_functions[ id ] ->c_name;
}

char *TYPE( OB o )
{
	if ( VD( o ) )
		return "???";
	return sather_types[ GET_TAG( o ) ] ->sather_name;
}

char *CTYPE( OB o )
{
	if ( VD( o ) )
		return "???";
	return sather_types[ GET_TAG( o ) ] ->c_name;
}



/*
 * works like printf, but changes indentation
 */ 
/*static void Pr( va_alist )*/
/*va_dcl*/
static void Pr( char *fmt, ... )
{
	va_list ap;
	char *f;
#ifdef STR_tag

	int cur_size;
	STR n;
#endif

	va_start( ap, fmt );
	/*f = va_arg( ap, char* );*/
	f = fmt;
	if ( !print_str ) {
		if ( print_need_indent ) {
			int i;
			for ( i = print_depth; i < print_orig_depth; i++ )
				printf( "   " );
			print_need_indent = 0;
		}
		if ( f[ strlen( f ) - 1 ] == '\n' )
			print_need_indent = 1;
		vprintf( f, ap );
#ifdef STR_tag

	} else {
		cur_size = cur_str_pos - str_buf->arr_part;
		if ( print_need_indent * ( print_orig_depth - print_depth ) * 3 + 200 + cur_size > str_buf->asize ) {
			n = ( STR ) rt_arr_alloc( sizeof( STR ), STR_tag, 1, str_buf->asize * 2 );
			n->asize = str_buf->asize * 2;
			memcpy( n->arr_part, str_buf->arr_part, str_buf->asize );
			cur_str_pos = n->arr_part + cur_size;
			str_buf = n;
		}
		if ( print_need_indent ) {
			int i;
			for ( i = print_depth; i < print_orig_depth; i++ ) {
				strcat( cur_str_pos, "   " );
				cur_str_pos += 3;
			}
			print_need_indent = 0;
		}
		if ( f[ strlen( f ) - 1 ] == '\n' )
			print_need_indent = 1;
		vsprintf( cur_str_pos, f, ap );
		cur_str_pos += strlen( cur_str_pos );
#endif

	}
	va_end(ap);
}

static int builtin_tag( OB ob )
{
	int tag;
	if ( VD( ob ) )
		return 0;
	tag = GET_TAG( ob );
	return 0
#ifdef INT_tag
	       || tag == INT_tag
#endif
#ifdef BOOL_tag
	       || tag == BOOL_tag
#endif
#ifdef CHAR_tag
	       || tag == CHAR_tag
#endif
#ifdef FLT_tag
	       || tag == FLT_tag
#endif
#ifdef FLTD_tag
	       || tag == FLTD_tag
#endif
#ifdef STR_tag
	       || tag == STR_tag
#endif
#ifdef FSTR_tag
	       || tag == FSTR_tag
#endif
#ifdef THREAD_ID_tag
	       || tag == THREAD_ID_tag
#endif
	       ;
}

static char *to_str( char c )
{
	static char p[ 5 ] = {'\\', '0', 0, 0, 0};
	switch ( c ) {
		case '\n':
			return "\\n";
		case '\r':
			return "\\r";
		case '\b':
			return "\\b";
		case '\t':
			return "\\t";
		case '\v':
			return "\\v";
		case '\a':
			return "\\a";
		case '"':
			return "\\\"";
		case '\'':
			return "\\'";
	}
	if ( c < ' ' ) {
		p[ 2 ] = c / 10 + '0';
		p[ 3 ] = c % 10 + '0';
		return p;
	}
	p[ 3 ] = c;
	return p + 3;
}

static char *source_file( long s )
{
	if ( s == 0 )
		return "??.sa";
	if ( print_short_source ) {
		char * p = source_files[ s >> 20 ];
		p += strlen( p ) - 1;
		while ( p >= source_files[ s >> 20 ] && *p != '/' )
			p--;
		return p + 1;
	}
	return source_files[ s >> 20 ];
}
static long source_line( long s )
{
	return s & 0xfffff;
}

static void no_garbage( void *g )
{
#define REACHABLE_SIZE 200
	static void **reachable = NULL;
	static int reachable_pos = 0;
	if ( g == NULL )
		return ;
	if ( reachable == NULL ) {
		reachable = calloc( sizeof( void * ), REACHABLE_SIZE );
		reachable_pos = 0;
	}
	if ( reachable_pos == REACHABLE_SIZE ) {
		void **p = reachable;
		reachable = calloc( sizeof( void * ), REACHABLE_SIZE );
		reachable_pos = 1;
		reachable[ 0 ] = p;
	}
	reachable[ reachable_pos++ ] = g;
}

#ifdef PRINT_POG
static void _printg_INT( INT d, char *p )
{
	sprintf( p, "%d", d );
}
static void _printg_CHAR( CHAR d, char *p )
{
	sprintf( p, "'%s'", to_str( d ) );
}
static void _printg_BOOL( BOOL d, char *p )
{
	sprintf( p, "%s", d ? "true" : "false" );
}
static void _printg_FLT( FLT d, char *p )
{
	sprintf( p, "%f", d );
}
static void _printg_FLTD( FLT d, char *p )
{
	sprintf( p, "%f", d );
}
static void _printg_STR( STR d, char *p )
{
	int i, size, as;
	if ( VD( d ) ) {
		sprintf( p, "[0] \"\"" );
		return ;
	}
	sprintf( p, "[%d] \"", as = d->asize );
	size = strlen( p ) + 8;
	p += strlen( p );
	for ( i = 0;i < as && size < PRINT_VALUE_SIZE;i++ ) {
		sprintf( p, "%s", to_str( d->arr_part[ i ] ) );
		size += strlen( p );
		p += strlen( p );
	}
	sprintf( p, "\"" );
}
static void _printg_FSTR( FSTR d, char *p )
{
	int i, size, as;
	if ( VD( d ) ) {
		sprintf( p, "[0/0] \"\"" );
		return ;
	}
	sprintf( p, "[%d/%d] \"", d->loc, as = d->asize );
	size = strlen( p ) + 8;
	p += strlen( p );
	for ( i = 0;i < d->loc && size < PRINT_VALUE_SIZE;i++ ) {
		sprintf( p, "%s", to_str( d->arr_part[ i ] ) );
		size += strlen( p );
		p += strlen( p );
	}
	sprintf( p, "\"" );
}
static void _printg_SYSID( OB ob, char *p )
{
	if ( GET_TAG( ob ) > 0 )
		sprintf( p, "%d", SID( ob ) );
}
static void _printg_GDB( OB ob, char *p )
{
	sprintf( p, "p POG(0x%x)", ob );
}
static void _printg_REF( void *ob, char *p )
{
	p[ 0 ] = 0;
	/* sprintf(p,"0x%x",ob); */
}
static void _printg_REF_GID( void *ob, char *p )
{
	sprintf( p, "o_0x%x_0x%x_0_0_0", print_Type, ob );
}
static void _printg_VAL_GID( void *ob, int tag, int cl, char *p )
{
	sprintf( p, "o_0x%x_0x%x_%d_%d_0", print_VType, ob, tag, cl );
}

static int INT__printg( INT *i )
{
	print_ct[ 0 ] = print_cr[ 0 ] = print_sr[ 0 ] = print_st[ 0 ] = "INT";
	print_TYPE[ 0 ] = PO_INT;
	_printg_INT( *i, print_VALUE[ 0 ] );
	return 1;
}
#define CHECKLINE print_current_line++; \
			if(print_current_line<print_start_line) continue; \
			if(print_current_line>=print_start_line+print_lines) { \
			   	print_last_line=0; \
				return index+c; \
			}

static int _printg_INT_arr( INT *v, int size, int index )
{
	int i, c, j;
	for ( c = i = 0;i < size;i += 10 ) {
		CHECKLINE;
		print_ct[ c + index ] = print_cr[ c + index ] = print_sr[ c + index ] = print_st[ c + index ] = "INT";
		sprintf( print_as_index[ c + index ], "[%2d]", i );
		print_sa[ c + index ] = print_as_index[ c + index ];
		sprintf( print_ac_index[ c + index ], "arr_part[%d]", i );
		print_ca[ c + index ] = print_ac_index[ c + index ];
		print_TYPE[ c + index ] = PO_INT;
		print_VALUE[ c + index ][ 0 ] = 0;
		for ( j = 0;j < 10 && i + j < size;j++ )
			sprintf( print_VALUE[ c + index ] + strlen( print_VALUE[ c + index ] ), "%12d,", v[ i + j ] );
		c++;
	}
	return index + c;
}
static int BOOL__printg( BOOL *i )
{
	print_ct[ 0 ] = print_cr[ 0 ] = print_sr[ 0 ] = print_st[ 0 ] = "BOOL";
	print_TYPE[ 0 ] = PO_BOOL;
	_printg_BOOL( *i, print_VALUE[ 0 ] );
	return 1;
}
static int _printg_BOOL_arr( BOOL *v, int size, int index )
{
	int i, c, j;
	for ( c = i = 0;i < size;i += 20 ) {
		CHECKLINE;
		print_ct[ c + index ] = print_cr[ c + index ] = print_sr[ c + index ] = print_st[ c + index ] = "BOOL";
		sprintf( print_as_index[ c + index ], "[%2d]", i );
		print_sa[ c + index ] = print_as_index[ c + index ];
		sprintf( print_ac_index[ c + index ], "arr_part[%d]", i );
		print_ca[ c + index ] = print_ac_index[ c + index ];
		print_TYPE[ c + index ] = PO_BOOL;
		print_VALUE[ c + index ][ 0 ] = 0;
		for ( j = 0;j < 20 && i + j < size;j++ )
			sprintf( print_VALUE[ c + index ] + strlen( print_VALUE[ c + index ] ), "%c ", v[ i + j ] ? 't' : 'f' );
		c++;
	}
	return index + c;
}
static int CHAR__printg( CHAR *i )
{
	print_ct[ 0 ] = print_cr[ 0 ] = print_sr[ 0 ] = print_st[ 0 ] = "CHAR";
	print_TYPE[ 0 ] = PO_CHAR;
	_printg_CHAR( *i, print_VALUE[ 0 ] );
	return 1;
}
static int _printg_CHAR_arr( CHAR *v, int size, int index )
{
	int i, c, j;
	for ( c = i = 0;i < size;i += 10 ) {
		CHECKLINE;
		print_ct[ c + index ] = print_cr[ c + index ] = print_sr[ c + index ] = print_st[ c + index ] = "CHAR";
		sprintf( print_as_index[ c + index ], "[%2d]", i );
		print_sa[ c + index ] = print_as_index[ c + index ];
		sprintf( print_ac_index[ c + index ], "arr_part[%d]", i );
		print_ca[ c + index ] = print_ac_index[ c + index ];
		print_TYPE[ c + index ] = PO_CHAR;
		print_VALUE[ c + index ][ 0 ] = 0;
		for ( j = 0;j < 10 && i + j < size;j++ )
			_printg_CHAR( v[ i + j ], print_VALUE[ c + index ] + strlen( print_VALUE[ c + index ] ) );
		c++;
	}
	return index + c;
}
static int FLT__printg( FLT *i )
{
	print_ct[ 0 ] = print_cr[ 0 ] = print_sr[ 0 ] = print_st[ 0 ] = "FLT";
	print_TYPE[ 0 ] = PO_FLT;
	_printg_FLT( *i, print_VALUE[ 0 ] );
	return 1;
}
static int _printg_FLT_arr( FLT *v, int size, int index )
{
	int i, c, j;
	for ( c = i = 0;i < size;i += 5 ) {
		CHECKLINE;
		print_ct[ c + index ] = print_cr[ c + index ] = print_sr[ c + index ] = print_st[ c + index ] = "FLT";
		sprintf( print_as_index[ c + index ], "[%2d]", i );
		print_sa[ c + index ] = print_as_index[ c + index ];
		sprintf( print_ac_index[ c + index ], "arr_part[%d]", i );
		print_ca[ c + index ] = print_ac_index[ c + index ];
		print_TYPE[ c + index ] = PO_FLT;
		print_VALUE[ c + index ][ 0 ] = 0;
		for ( j = 0;j < 5 && i + j < size;j++ )
			sprintf( print_VALUE[ c + index ] + strlen( print_VALUE[ c + index ] ), "%f, ", v[ i + j ] );
		c++;
	}
	return index + c;
}
static int FLTD__printg( FLTD *i )
{
	print_ct[ 0 ] = print_cr[ 0 ] = print_sr[ 0 ] = print_st[ 0 ] = "FLTD";
	print_TYPE[ 0 ] = PO_FLTD;
	_printg_FLTD( *i, print_VALUE[ 0 ] );
	return 1;
}
static int _printg_FLTD_arr( FLTD *v, int size, int index )
{
	int i, c, j;
	for ( c = i = 0;i < size;i += 5 ) {
		CHECKLINE;
		print_ct[ c + index ] = print_cr[ c + index ] = print_sr[ c + index ] = print_st[ c + index ] = "FLTD";
		sprintf( print_as_index[ c + index ], "[%2d]", i );
		print_sa[ c + index ] = print_as_index[ c + index ];
		sprintf( print_ac_index[ c + index ], "arr_part[%d]", i );
		print_ca[ c + index ] = print_ac_index[ c + index ];
		print_TYPE[ c + index ] = PO_FLTD;
		print_VALUE[ c + index ][ 0 ] = 0;
		for ( j = 0;j < 5 && i + j < size;j++ )
			sprintf( print_VALUE[ c + index ] + strlen( print_VALUE[ c + index ] ), "%f, ", v[ i + j ] );
		c++;
	}
	return index + c;
}
static int STR__printg( STR i )
{
	print_ct[ 0 ] = print_cr[ 0 ] = print_sr[ 0 ] = print_st[ 0 ] = "STR";
	print_TYPE[ 0 ] = PO_STR;
	_printg_STR( i, print_VALUE[ 0 ] );
	_printg_REF_GID( ( OB ) i, print_GID[ 0 ] );
	return 1;
}
static int FSTR__printg( FSTR i )
{
	print_ct[ 0 ] = print_cr[ 0 ] = print_sr[ 0 ] = print_st[ 0 ] = "FSTR";
	print_TYPE[ 0 ] = PO_STR;
	_printg_FSTR( i, print_VALUE[ 0 ] );
	_printg_REF_GID( ( OB ) i, print_GID[ 0 ] );
	return 1;
}

static int _printg_VAL_arr( char *d, int size, int elsize, int index, char *st, char *ct, int tg, char *rp, int where )
{
	int i;
	int l;
	for ( i = 0;i < size;i++, d += elsize, rp += elsize ) {
		print_current_line++;
		if ( print_current_line < print_start_line )
			continue;
		if ( print_current_line >= print_start_line + print_lines ) {
			print_last_line = 0;
			return index;
		}
		print_cr[ index ] = print_ct[ index ] = ct;
		print_sr[ index ] = print_st[ index ] = st;
		print_TYPE[ index ] = PO_VAL;
#ifdef PSATHER

		_printg_VAL_GID( rp, tg, where, print_GID[ index ] );
#else

		_printg_VAL_GID( d, tg, where, print_GID[ index ] );
#endif

		sprintf( print_as_index[ index ], "[%d]", i );
		print_sa[ index ] = print_as_index[ index ];
		sprintf( print_ac_index[ index ], "arr_part[%d]", i );
		print_ca[ index ] = print_ac_index[ index ];
		index++;
	}
	return index;
}
static int _printg_xREF_arr( OB *d, int size, int index, char *st, char *ct, void ( *f ) ( OB, char * ), int ref )
{
	int i;
	int l;
	for ( l = i = 0;i < size;i++ ) {
		if ( !VD( d[ i ] ) || print_void ) {
			print_current_line++;
			if ( print_current_line < print_start_line )
				continue;
			if ( print_current_line >= print_start_line + print_lines ) {
				print_last_line = 0;
				return index;
			}
			print_cr[ index ] = TYPE( ( OB ) d[ i ] );
			print_ct[ index ] = ct;
			print_sr[ index ] = CTYPE( ( OB ) d[ i ] );
			print_st[ index ] = st;
			print_TYPE[ index ] = ref;
			if ( !VD( d[ i ] ) ) {
				printf( "OB(0x%x)[%d]->tag=%d\n", d[ i ], i, GET_TAG( ( OB ) d[ i ] ) );
				switch ( GET_TAG( ( OB ) d[ i ] ) ) {
#ifdef INT_tag
					case INT_tag:
						_printg_INT( ( ( INT_boxed ) d[ i ] ) ->immutable_part, print_VALUE[ index ] );
						break;
#endif
#ifdef BOOL_tag

					case BOOL_tag:
						_printg_BOOL( ( ( BOOL_boxed ) d[ i ] ) ->immutable_part, print_VALUE[ index ] );
						break;
#endif
#ifdef CHAR_tag

					case CHAR_tag:
						_printg_CHAR( ( ( CHAR_boxed ) d[ i ] ) ->immutable_part, print_VALUE[ index ] );
						break;
#endif
#ifdef FLT_tag

					case FLT_tag:
						_printg_FLT( ( ( FLT_boxed ) d[ i ] ) ->immutable_part, print_VALUE[ index ] );
						break;
#endif
#ifdef FLTD_tag

					case FLTD_tag:
						_printg_FLTD( ( ( FLTD_boxed ) d[ i ] ) ->immutable_part, print_VALUE[ index ] );
						break;
#endif
#ifdef THREAD_ID_tag

					case THREAD_ID_tag:
						_printg_THREAD_ID( ( ( THREAD_ID_boxed ) d[ i ] ) ->immutable_part, print_VALUE[ index ] );
						break;
#endif
#ifdef STR_tag

					case STR_tag:
						_printg_STR( ( STR ) d[ i ], print_VALUE[ index ] );
						break;
#endif
#ifdef FSTR_tag

					case FSTR_tag:
						_printg_FSTR( ( FSTR ) d[ i ], print_VALUE[ index ] );
						break;
#endif

					default:
						_printg_SYSID( ( OB ) d[ i ], print_SID[ index ] );
						_printg_REF_GID( ( OB ) d[ i ], print_GID[ index ] );
						_printg_GDB( ( OB ) d[ i ], print_GDB[ index ] );
				}
			}
			sprintf( print_as_index[ index ], "[%d]", i );
			print_sa[ index ] = print_as_index[ index ];
			sprintf( print_ac_index[ index ], "arr_part[%d]", i );
			print_ca[ index ] = print_ac_index[ index ];
			/*		(*f)(d[i],print_VALUE[index]);*/
			index++;
			l++;
		}
	}
	if ( l == 0 && size != 0 ) {
		for ( i = 0;i < size;i++ )
			if ( !VD( d[ i ] ) )
				break;
		if ( i == size ) {
			strcpy( print_VALUE[ index ], "ALL VOID" );
			print_ct[ index ] = ct;
			print_st[ index ] = st;
			print_TYPE[ index ] = ref;
			print_ca[ index ] = "arr_part[*]";
			print_sa[ index ] = "[*]";
			index++;
		}
	}
	return index;
}
static int _printg_STR_arr( STR *d, int size, int index, char *st, char *ct )
{
	return _printg_xREF_arr( ( OB* ) d, size, index, st, ct, ( void ( * ) ( OB, char * ) ) _printg_STR, PO_STR );
}
static int _printg_FSTR_arr( FSTR *d, int size, int index, char *st, char *ct )
{
	return _printg_xREF_arr( ( OB* ) d, size, index, st, ct, ( void ( * ) ( OB, char * ) ) _printg_FSTR, PO_FSTR );
}
static int _printg_REF_arr( void *d, int size, int index, char *st, char *ct )
{
	return _printg_xREF_arr( ( OB* ) d, size, index, st, ct, ( void ( * ) ( OB, char * ) ) _printg_REF, PO_REF );
}
#endif /* PRINT_POG */

static int _print_INT( INT d )
{
	Pr( "%d", d );
	return 1;
}
static int _print_CHAR( CHAR d )
{
	Pr( "'%s'", to_str( d ) );
	return 1;
}
static int _print_BOOL( BOOL d )
{
	Pr( "%s", d ? "true" : "false" );
	return 1;
}
#ifdef THREAD_ID_tag
static int _print_THREAD_ID( THREAD_ID d )
{
	char t[ 30 ];
	thr_print_id( d, t );
	Pr( "%s", t );
	return 1;
}
#endif
static int _print_FLT( FLT d )
{
	Pr( "%f", d );
	return 1;
}
static int _print_FLTD( FLT d )
{
	Pr( "%f", d );
	return 1;
}
static int _print_STR( STR rd )
{
	int i;
	STR d;
#ifdef PSATHER

	if ( FVOID( rd ) )
		d = NULL;
	else if ( NEAR( rd ) )
		d = rd;
	else {
#ifdef STR_tag
		d = ( STR ) get_remote_object( SENDFOBHOME( rd ), WHERE( rd ), STR_tag, 0 );
#endif

	}
#else
	d = rd;
#endif

	if ( VD( d ) ) {
		Pr( "[0] \"\"" );
		return ;
	}
	Pr( "[%d] \"", d->asize );
	for ( i = 0;i < d->asize && i < print_str_len;i++ )
		Pr( "%s", to_str( d->arr_part[ i ] ) );
	if ( i != d->asize )
		Pr( "..." );
	Pr( "\"" );
	return 1;
}
static int _print_FSTR( FSTR rd )
{
	int i;
	FSTR d;
#ifdef PSATHER

	if ( FVOID( rd ) )
		d = NULL;
	else if ( NEAR( rd ) )
		d = rd;
	else {
#ifdef FSTR_tag
		d = ( FSTR ) get_remote_object( SENDFOBHOME( rd ), WHERE( rd ), FSTR_tag, 0 );
#endif

	}
#else
	d = rd;
#endif

	if ( VD( d ) ) {
		Pr( "[0/0] \"\"" );
		return ;
	}
	Pr( "[%d/%d] \"", d->loc, d->asize );
	for ( i = 0;i < d->asize && i < print_str_len;i++ )
		Pr( "%s", to_str( d->arr_part[ i ] ) );
	if ( i != d->asize )
		Pr( "..." );
	Pr( "\"" );
	return 1;
}
static int _print_STR_arr( STR *d, int size )
{
	int i;
	int l;
	for ( l = i = 0;i < size && l < print_index;i++ ) {
		if ( !VD( d[ i ] ) || print_void ) {
			Pr( "[%3d]: ", i );
			_print_STR( d[ i ] );
			l++;
			if ( l == print_index && i != size - 1 )
				Pr( "  ..." );
			Pr( "\n" );
		}
	}
	if ( l == 0 && size != 0 )
		Pr( "     ALL VOID\n" );
}
static int _print_FSTR_arr( FSTR *d, int size )
{
	int i;
	int l;
	for ( l = i = 0;i < size && l < print_index;i++ ) {
		if ( !VD( d[ i ] ) || print_void ) {
			Pr( "[%3d]: ", i );
			_print_FSTR( d[ i ] );
			l++;
			if ( l == print_index && i != size - 1 )
				Pr( "  ..." );
			Pr( "\n" );
		}
	}
	if ( l == 0 && size != 0 )
		Pr( "     ALL VOID\n" );
}
static int _print_INT_arr( INT *d, int size )
{
	int i;
	int l;
	l = print_index < size ? print_index : size;
	for ( i = 0;i < l;i++ ) {
		if ( i % 5 == 0 )
			Pr( "[%3d]: ", i );
		Pr( "%12d", d[ i ] );
		if ( i % 5 == 4 ) {
			if ( i == l - 1 && l < size )
				Pr( "  ..." );
			Pr( "\n" );
		}
	}
	if ( i % 5 != 0 ) {
		if ( l < size )
			Pr( "  ..." );
		Pr( "\n" );
	}
}
#ifdef THREAD_ID_tag
static int _print_THREAD_ID_arr( THREAD_ID *d, int size )
{
	int i;
	int l;
	l = print_index < size ? print_index : size;
	for ( i = 0;i < l;i++ ) {
		char t[ 30 ];
		if ( i % 5 == 0 )
			Pr( "[%3d]: ", i );
		thr_print_id( d[ i ], t );
		Pr( "%s", t );
		if ( i % 5 == 4 ) {
			if ( i == l - 1 && l < size )
				Pr( "  ..." );
			Pr( "\n" );
		}
	}
	if ( i % 5 != 0 ) {
		if ( l < size )
			Pr( "  ..." );
		Pr( "\n" );
	}
}
#endif
static int _print_BOOL_arr( BOOL *d, int size )
{
	int i;
	int l;
	l = print_index < size ? print_index : size;
	for ( i = 0;i < l;i++ ) {
		if ( i % 30 == 0 )
			Pr( "[%3d]: ", i );
		Pr( "%c ", d[ i ] ? 'T' : 'F' );
		if ( i % 30 == 29 ) {
			if ( i == l - 1 && l < size )
				Pr( "  ..." );
			Pr( "\n" );
		}
	}
	if ( i % 30 != 0 ) {
		if ( l < size )
			Pr( "  ..." );
		Pr( "\n" );
	}
}
static int _print_FLT_arr( FLT *d, int size )
{
	int i;
	int l;
	l = print_index < size ? print_index : size;
	for ( i = 0;i < l;i++ ) {
		if ( i % 5 == 0 )
			Pr( "[%3d]: ", i );
		Pr( "%f  ", d[ i ] );
		if ( i % 5 == 4 ) {
			if ( i == l - 1 && l < size )
				Pr( "  ..." );
			Pr( "\n" );
		}
	}
	if ( i % 5 != 0 ) {
		if ( l < size )
			Pr( "  ..." );
		Pr( "\n" );
	}
}
static int _print_FLTD_arr( FLTD *d, int size )
{
	int i;
	int l;
	l = print_index < size ? print_index : size;
	for ( i = 0;i < l;i++ ) {
		if ( i % 5 == 0 )
			Pr( "[%3d]: ", i );
		Pr( "%10f", d[ i ] );
		if ( i % 5 == 4 ) {
			if ( i == l - 1 && l < size )
				Pr( "  ..." );
			Pr( "\n" );
		}
	}
	if ( i % 5 != 0 ) {
		if ( l < size )
			Pr( "  ..." );
		Pr( "\n" );
	}
}
static int _print_CHAR_arr( CHAR *d, int size )
{
	int i;
	Pr( "\"" );
	for ( i = 0;i < size;i++ )
		Pr( "%s", to_str( d[ i ] ) );
	Pr( "\"\n" );
}

static int _print_VAL_arr( char *p, int size, int elsize, int tg, char *rp, int where )
{
	int i;
	int l;
	l = print_index < size ? print_index : size;
	for ( i = 0;i < l;i++ ) {
		Pr( "[%3d]: ", i );
#ifdef PSATHER

		if ( print_gdb )
			Pr( "p POV(0x%x,%d,%d)", rp, tg, where );
#else

		if ( print_gdb )
			Pr( "p POV(0x%x,%d)", p, tg );
#endif

		Pr( "\n" );
		if ( print_depth > 1 ) {
			print_depth--;
			print_Type( ( void * ) p, tg );
			print_depth++;
		}
		p += elsize;
	}
	if ( l < size )
		Pr( "  ...\n" );
}

static int _print_REF_arr( OB *p, int size )
{
	int i;
	int l;
	int c;
	for ( c = i = 0;i < size && c < print_index;i++ ) {
		if ( !VD( p[ i ] ) || print_void ) {
			c++;
			Pr( "[%3d]", i );
			if ( VD( p[ i ] ) ) {
				Pr( ": (void)\n" );
			} else {
				Pr( ":" );
				if ( print_real )
					Pr( " %s", TYPE( p[ i ] ) );
				if ( print_c_real )
					Pr( " (%s)", CTYPE( p[ i ] ) );
				if ( builtin_tag( ( OB ) p[ i ] ) ) {
					Pr( "  " );
					print_Type( p[ i ], 0 );
				} else {
					if ( print_id && GET_TAG( p[ i ] ) > 0 )
						Pr( "  [ID %d]", SID( p[ i ] ) );
					if ( print_pointer && GET_TAG( p[ i ] ) > 0 )
						Pr( "  [C 0x%x]", p[ i ] );
					if ( print_gdb )
						Pr( "  p PO(0x%x)", p[ i ] );
					Pr( "\n" );
					if ( print_depth > 1 ) {
						print_depth--;
						print_Type( p[ i ], 0 );
						print_depth++;
					}
				}
			}
		}
	}
	if ( c == 0 && size != 0 )
		Pr( "     ALL VOID\n" );
	else if ( i < size )
		Pr( "      ...\n" );

}

void POV( OB rob, int tg
#ifdef PSATHER
          , int where
#endif
        )
{
	int tag = tg;
	OB ob;
	ON_SIGNAL
#ifdef PSATHER
	if ( tg != 0 )
		ob = get_remote_object( rob, where, tg, 0 );
	else
		ob = rob;
#else

	ob = rob;
#endif

	print_orig_depth = print_depth;
	print_need_indent = 1;
	print_in_pog = 0;
	if ( VD( ob ) ) {
		Pr( "(void)\n" );
		return ;
	}
	if ( tg == 0 )
		tag = GET_TAG( ob );
	Pr( "class %s", sather_types[ tag ] ->sather_name );
	if ( print_id && tag > 0 )
		Pr( "  [ID %d]", SID( ob ) );
	if ( print_pointer && tag > 0 )
		Pr( "  [C 0x%x]", ob );
	Pr( ":\n" ) ;
	print_Type( ob, tg );
	ON_SIGNAL_DO
	Pr( "\n" );
	ON_SIGNAL_END
}

void print_object( OB ob )
{
	PO( ob );
}

#ifdef PSATHER
void PO( OB ob )
{
	POV( ob, 0, 0 );
}
#else
void PO( OB ob )
{
	POV( ob, 0 );
}
#endif

#ifdef STR_tag
void *POSTR( OB ob )
{
	print_str = 1;
	str_buf = ( STR ) rt_arr_alloc( sizeof( STR ), STR_tag, 1, 500 );
	str_buf->asize = 500;
	cur_str_pos = str_buf->arr_part;
	PO( ob );
	print_str = 0;
	str_buf->asize = strlen( str_buf->arr_part );
	return str_buf;
}
#endif

#ifdef PRINT_POG

#ifdef PRINT_POG_DEBUG 
/* the following 3 functions are for debugging,
 * and should be deleted as soon as the GUI works
 */
STR C_POG_cget( STR id );
static int C_POG_run()
{}
static int C_POG_init()
{}
static int C_POG_show( STR s )
{
	STR t;
	char *p;
	char *l;
	int i, j;
	t = C_POG_cget( s );
	p = t->arr_part;
	l = p + t->asize;
	i = 0;
	j = 0;
	while ( p < l ) {
		if ( i == 0 )
			printf( "%d.: ", j++ );
		printf( "%s", p );
		i++;
		if ( i == 10 )
			printf( "\n" ), i = 0;
		else
			printf( ", " );
		p += strlen( p ) + 1;
	}
}
#endif /* PRINT_POG_DEBUG */


void PFG( struct _func_frame *f )
{
	struct
	{
		OB_HEADER header;
		INT asize;
		CHAR arr_part[ PRINT_GID_SIZE + 10 ];
	}
	s = { {STR_tag}, PRINT_GID_SIZE, "" };
	C_POG_init();
	if ( !VD( f ) )
	{
		sprintf( s.arr_part, "o_0x%x_0x%x_0_0", print_Func, f );
		s.asize = strlen( s.arr_part );
		C_POG_show( ( STR ) & s );
	}
	C_POG_run();
}

void PGET_TAG( struct _func_frame *f )
{
	struct
	{
		OB_HEADER header;
		INT asize;
		CHAR arr_part[ PRINT_GID_SIZE + 10 ];
	}
	s = { {STR_tag}, PRINT_GID_SIZE, "" };
	C_POG_init();
	if ( !VD( f ) )
	{
		sprintf( s.arr_part, "fx0x%x", f );
		s.asize = strlen( s.arr_part );
		C_POG_show( ( STR ) & s );
	}
	C_POG_run();
}

void view_object( OB ob )
{
	POG( ob );
}
void POG( OB ob )
{
	struct {
		OB_HEADER header;
		INT asize;
		CHAR arr_part[ 10 ];
	}
	s = { {STR_tag}, PRINT_SID_SIZE, "" };
	C_POG_init();
	if ( !VD( ob ) ) {
		_printg_REF_GID( ob, s.arr_part );
		s.asize = strlen( s.arr_part );
		C_POG_show( ( STR ) & s );
	}
	C_POG_run();
}

static STR get_func_trace( STR id )
{
	int ( *func ) ( void * );
	int at;
	int size;
	int i;
	struct _func_frame *ff, *f;
	long a, b;
	char *p;
	STR res;
	sscanf( id->arr_part, "fx%li", &a );
	f = ff = ( struct _func_frame * ) a;
	size = 0;
	for ( i = 0;i < print_func;i++ ) {
		size += strlen( _print_FUNC( f->func ) );
		size += strlen( _print_FUNCP( f->func ) );
		f = f->prev;
		if ( VD( f ) )
			break;
	}
	size += 60 * ( i + 3 );
	res = ( STR ) rt_arr_alloc( sizeof( STR ), STR_tag, 1, size );
	p = ( char * ) res->arr_part;
	/* TITLE */
	/*GID*/
	strncpy( p, id->arr_part, id->asize );
	p[ id->asize ] = 0;
	p += strlen( p ) + 1;
	/*C1*/
	strcat( p, "Stack Trace" );
	p += strlen( p ) + 1;
	/*C2*/
	*p++ = 0;
	/*TYPE*/
	*p++ = 0;
	/*COL*/
	strcat( p, OUT_OF_BAND_COLOR );
	p += strlen( p ) + 1;
	/*S1*/
	*p++ = 0;
	/*S2*/
	*p++ = 0;
	/*S3*/
	*p++ = 0;
	/*S4*/
	*p++ = 0;
	/*S5*/
	*p++ = 0;

	for ( f = ff, i = 1;i < print_func + 1;i++ ) {
		/* GID C1 C2 TYPE COLOR S1 S2 S3 S4 S5 */
		/*GID*/	sprintf(   p,   "o_0x%x_0x%x_0_0",   print_Func,   f );
		p += strlen( p ) + 1;
		/*C1*/
		strcat( p, _print_FUNC( f->func ) );
		p += strlen( p ) + 1;
		/*C2*/
		strcat( p, _print_FUNCP( f->func ) );
		p += strlen( p ) + 1;
		/*TYPE*/
		*p++ = 0;
		/*COL*/
		strcat( p, FRAME_COLOR );
		p += strlen( p ) + 1;
		/*S1*/
		*p++ = 0;
		/*S2*/
		*p++ = 0;
		/*S3*/
		*p++ = 0;
		/*S4*/
		*p++ = 0;
		/*S5*/
		*p++ = 0;
		f = f->prev;
		if ( VD( f ) )
			break;
	}
	if ( !VD( f ) ) {
		/* LAST LINE */
		/*GID*/	sprintf(   p,   "fx0x%x",   f );
		p += strlen( p ) + 1;
		/*C1*/
		strcat( p, "next part of Stack Trace" );
		p += strlen( p ) + 1;
		/*C2*/
		*p++ = 0;
		/*TYPE*/
		*p++ = 0;
		/*COL*/
		strcat( p, OUT_OF_BAND_COLOR );
		p += strlen( p ) + 1;
		/*S1*/
		*p++ = 0;
		/*S2*/
		*p++ = 0;
		/*S3*/
		*p++ = 0;
		/*S4*/
		*p++ = 0;
		/*S5*/
		*p++ = 0;
	} else {
		/* LAST LINE */
		/*GID*/	*p++ =   0;
		/*C1*/
		strcat( p, "BOTTOM" );
		p += strlen( p ) + 1;
		/*C2*/
		*p++ = 0;
		/*TYPE*/
		*p++ = 0;
		/*COL*/
		strcat( p, OUT_OF_BAND_COLOR );
		p += strlen( p ) + 1;
		/*S1*/
		*p++ = 0;
		/*S2*/
		*p++ = 0;
		/*S3*/
		*p++ = 0;
		/*S4*/
		*p++ = 0;
		/*S5*/
		*p++ = 0;
	}

	res->asize = p - res->arr_part;
	if ( res->asize > size ) {
		printf( "oops, size %d < res->asize %d, aborting\n", size, res->asize );
		abort();
	}
	return res;
}

static char *collect_function( char *p, int i )
{
	/*GID*/	if   (   !VD(   print_GID[   i ]   )   )
	strcpy( p, print_GID[ i ] );
	p += strlen( p ) + 1;
	p[ 0 ] = 0;
	/*C1*/
	if ( !VD( print_sa[ i ] ) )
		strcat( p, print_sa[ i ] );
	p += strlen( p ) + 1;
	/*C2*/
	if ( !VD( print_ca[ i ] ) )
		strcat( p, print_ca[ i ] );
	p += strlen( p ) + 1;
	/*TYPE*/
	*p++ = 0;
	/*COL*/
	strcat( p, FRAME_COLOR );
	p += strlen( p ) + 1;
	/*S1*/
	*p++ = 0;
	/*S2*/
	*p++ = 0;
	/*S3*/
	*p++ = 0;
	/*S4*/
	*p++ = 0;
	/*S5*/
	*p++ = 0;
	return p;
}
static char *collect_object( char *p, int i )
{
	/*GID*/	if   (   !VD(   print_GID[   i ]   )   )
	strcpy( p, print_GID[ i ] );
	p += strlen( p ) + 1;
	p[ 0 ] = 0;
	/*C1*/
	if ( !VD( print_sa[ i ] ) && print_attr )
		strcat( p, print_sa[ i ] );
	if ( print_type || print_real ) {
		if ( !VD( print_sa[ i ] ) && strlen( print_sa[ i ] ) && print_attr )
			strcat( p, ":" );
		/* if(print_real && !VD(print_sr[i]) && strlen(print_sr[i]))
			strcat(p,print_sr[i]); 
		else */
		if ( !VD( print_st[ i ] ) )
			strcat( p, print_st[ i ] );
	}
	p += strlen( p ) + 1;
	/*C2*/
	if ( !VD( print_VALUE[ i ] ) && strlen( print_VALUE[ i ] ) )
		strcat( p, print_VALUE[ i ] );
	else if ( ( !VD( print_sr[ i ] ) && strlen( print_sr[ i ] ) )
	          && ( VD( print_st[ i ] ) || strlen( print_st[ i ] ) == 0 ||
	               strcmp( print_st[ i ], print_sr[ i ] ) ) )
		sprintf( p, "[%s]", print_sr[ i ] );
	p += strlen( p ) + 1;
	/*TYPE*/ /*if(!VD(print_TYPE[i])) strcat(p,print_TYPE[i]);*/
	strcat( p, "" );
	p += strlen( p ) + 1;
	/*COL*/
	strcpy( p, "white" ); /* default value */
	switch ( print_TYPE[ i ] & PO_NAME_MASK ) {
		case PO_ARRAY:
			strcpy( p, OUT_OF_BAND_COLOR );
			break;
		case PO_ARG:
		case PO_ATTR:
		case PO_TITLE:
			switch ( print_TYPE[ i ] & PO_TYPE_MASK ) {
				case PO_VAL:
					strcpy( p, PO_VAL_ARGATTR_COLOR );
					break;
				case PO_REF:
				case PO_EXT_OB:
				case PO_BND_ROUT:
					strcpy( p, PO_REF_ARGATTR_COLOR );
					break;
				default:
					strcpy( p, PO_BLT_ARGATTR_COLOR );
					break;
			}
			break;
		default:
			switch ( print_TYPE[ i ] & PO_TYPE_MASK ) {
				case PO_VAL:
					strcpy( p, PO_VAL_LOCAL_COLOR );
					break;
				case PO_REF:
				case PO_EXT_OB:
				case PO_BND_ROUT:
					strcpy( p, PO_REF_LOCAL_COLOR );
					break;
				default:
					strcpy( p, PO_BLT_LOCAL_COLOR );
					break;
			}
			break;
	}
	p += strlen( p ) + 1;
	/*S1*/
	strcpy( p, "SATHER: " );
	p += strlen( p );
	if ( !VD( print_nm[ i ] ) ) {
		strcat( p, print_nm[ i ] );
		strcat( p, " " );
	}
	if ( !VD( print_sa[ i ] ) ) {
		strcat( p, print_sa[ i ] );
		strcat( p, ":" );
	}
	if ( !VD( print_st[ i ] ) )
		strcat( p, print_st[ i ] );
	if ( ( !VD( print_st[ i ] ) && !VD( print_sr[ i ] ) && strcmp( print_st[ i ], print_sr[ i ] ) )
	        || ( !VD( print_sr[ i ] ) && VD( print_st[ i ] ) ) ) {
		strcat( p, " [" );
		if ( !VD( print_sr[ i ] ) )
			strcat( p, print_sr[ i ] );
		strcat( p, "]" );
	}
	p += strlen( p ) + 1;
	/*S2*/
	strcpy( p, "C:      " );
	p += strlen( p );
	if ( !VD( print_ct[ i ] ) )
		strcat( p, print_ct[ i ] );
	if ( ( !VD( print_ct[ i ] ) && !VD( print_cr[ i ] ) && strcmp( print_ct[ i ], print_cr[ i ] ) )
	        || ( !VD( print_cr[ i ] ) && VD( print_ct[ i ] ) ) ) {
		strcat( p, " [" );
		if ( !VD( print_cr[ i ] ) )
			strcat( p, print_cr[ i ] );
		strcat( p, "]" );
	}
	strcat( p, " " );
	if ( !VD( print_ca[ i ] ) )
		strcat( p, print_ca[ i ] );
	p += strlen( p ) + 1;
	/*S3*/
	if ( !VD( print_VALUE[ i ] ) && strlen( print_VALUE[ i ] ) )
		sprintf( p, "VALUE:  %s", print_VALUE[ i ] );
	p += strlen( p ) + 1;
	/*S4*/
	if ( !VD( print_SID[ i ] ) && strlen( print_SID[ i ] ) )
		sprintf( p, "SYS::id()=%s", print_SID[ i ] );
	p += strlen( p ) + 1;
	/*S5*/
	*p++ = 0;
	return p;
}

static STR get_object( STR id )
{
	int ( *func ) ( void *, int, int );
	int at;
	int size;
	int i;
	void *ob;
	long a, b, tg;
	char *p;
	STR res;
	long lines, where;
	char sid[ 40 ];
	ON_SIGNAL
	strncpy( sid, id->arr_part, id->asize );
	sid[ id->asize ] = 0;
	sscanf( id->arr_part, "o_%li_%li_%ld_%ld_%ld", &a, &b, &tg, &lines, &where );
	func = ( int ( * ) ( void *, int, int ) ) a;
	ob = ( void * ) b;
	print_start_line = lines;
	if ( print_start_line == 0 )
		print_start_line = 1;
	print_current_line = 0;
	print_last_line = 1;
	print_in_pog = 1;
	( *func ) ( ob, tg, where );
	strcpy( print_GID[ 0 ], sid );
	at = print_in_pog - 1;
	print_in_pog = 0;
	for ( size = i = 0;i < at;i++ ) {
		if ( !VD( print_st[ i ] ) )
			size += 2 * strlen( print_st[ i ] );
		if ( !VD( print_sa[ i ] ) )
			size += 2 * strlen( print_sa[ i ] );
		if ( !VD( print_sr[ i ] ) )
			size += 2 * strlen( print_sr[ i ] );
		if ( !VD( print_cr[ i ] ) )
			size += 2 * strlen( print_cr[ i ] );
		if ( !VD( print_ct[ i ] ) )
			size += 2 * strlen( print_ct[ i ] );
		if ( !VD( print_ca[ i ] ) )
			size += 2 * strlen( print_ca[ i ] );
		if ( !VD( print_nm[ i ] ) )
			size += 2 * strlen( print_nm[ i ] );
		size += strlen( print_SID[ i ] );
		size += 2 * strlen( print_VALUE[ i ] );
		size += strlen( print_GID[ i ] );
		size += strlen( print_GDB[ i ] );
		size += 50; /* field delimiter, and color */
	}
	size += 50; /* for last lines */
	res = ( STR ) rt_arr_alloc( sizeof( STR ), STR_tag, 1, size );
	p = ( char * ) res->arr_part;
	for ( i = 0;i < at;i++ ) {
		/* GID C1 C2 TYPE COLOR S1 S2 S3 S4 S5 */
		switch ( print_TYPE[ i ] & PO_NAME_MASK ) {
			case PO_FUNC:
				p = collect_function( p, i );
				break;
			case PO_ARG:
			case PO_LOCAL:
			case PO_TITLE:
			case PO_ARRAY:
			case PO_ATTR:
				p = collect_object( p, i );
				break;
		}
	}
	if ( !print_last_line ) {
		/* LAST LINE */
		/*GID*/	strcat(   p,   print_GID[   0 ]   );
		p += strlen( p ) - 1;
		while ( *p && *p != '_' )
			p--;
		p--;
		while ( *p && *p != '_' )
			p--;
		sprintf( p + 1, "%d_%d", print_start_line + print_lines, where );
		p += strlen( p ) + 1;
		/*C1*/
		strcat( p, "next part of Object" );
		p += strlen( p ) + 1;
		/*C2*/
		*p++ = 0;
		/*TYPE*/
		*p++ = 0;
		/*COL*/
		strcat( p, OUT_OF_BAND_COLOR );
		p += strlen( p ) + 1;
		/*S1*/
		*p++ = 0;
		/*S2*/
		*p++ = 0;
		/*S3*/
		*p++ = 0;
		/*S4*/
		*p++ = 0;
		/*S5*/
		*p++ = 0;
	}
	res->asize = p - res->arr_part;
	if ( res->asize > size ) {
		printf( "oops, size %d < res->asize %d, aborting\n", size, res->asize );
		abort();
	}
	ON_SIGNAL_DO
	res = NULL;
	ON_SIGNAL_END
	return res;
}

STR C_POG_cget( STR id )
{
	int ( *func ) ( void * );
	int at;
	int size;
	int i;
	void *ob;
	long a, b;
	char *p;
	STR res;
	if ( VD( id ) || id->asize == 0 )
		return id;
	if ( print_num_of_attr < NUM_OF_ATTR + print_index + 4 || print_num_of_attr < print_func + 4 ) {
		print_num_of_attr = NUM_OF_ATTR + print_index + 3;
		if ( print_num_of_attr < print_func )
			print_num_of_attr = print_func + 3;
		print_num_of_attr += 5;
		if ( !VD( print_st ) )
			free( print_st );
		if ( !VD( print_ct ) )
			free( print_ct );
		if ( !VD( print_sa ) )
			free( print_sa );
		if ( !VD( print_ca ) )
			free( print_ca );
		if ( !VD( print_sr ) )
			free( print_sr );
		if ( !VD( print_cr ) )
			free( print_cr );
		if ( !VD( print_SID ) )
			free( print_SID );
		if ( !VD( print_VALUE ) )
			free( print_VALUE );
		if ( !VD( print_GID ) )
			free( print_GID );
		if ( !VD( print_GDB ) )
			free( print_GDB );
		if ( !VD( print_TYPE ) )
			free( print_TYPE );
		if ( !VD( print_nm ) )
			free( print_nm );

		print_st = ( char ** ) calloc( sizeof( char * ) * print_num_of_attr, 1 );
		print_sa = ( char ** ) calloc( sizeof( char * ) * print_num_of_attr, 1 );
		print_ct = ( char ** ) calloc( sizeof( char * ) * print_num_of_attr, 1 );
		print_ca = ( char ** ) calloc( sizeof( char * ) * print_num_of_attr, 1 );
		print_sr = ( char ** ) calloc( sizeof( char * ) * print_num_of_attr, 1 );
		print_cr = ( char ** ) calloc( sizeof( char * ) * print_num_of_attr, 1 );
		print_SID = ( print_SID_t * ) calloc( sizeof( print_SID_t ) * print_num_of_attr, 1 );
		print_VALUE = ( print_VALUE_t * ) calloc( sizeof( print_VALUE_t ) * print_num_of_attr, 1 );
		print_GDB = ( print_GDB_t * ) calloc( sizeof( print_GDB_t ) * print_num_of_attr, 1 );
		print_GID = ( print_GID_t * ) calloc( sizeof( print_GID_t ) * print_num_of_attr, 1 );
		print_TYPE = ( unsigned long * ) calloc( sizeof( unsigned int ) * print_num_of_attr, 1 );
		print_nm = ( char ** ) calloc( sizeof( char * ) * print_num_of_attr, 1 );
	} else {
		memset( print_sr, 0, sizeof( print_st[ 0 ] ) * print_num_of_attr );
		memset( print_cr, 0, sizeof( print_st[ 0 ] ) * print_num_of_attr );
		memset( print_st, 0, sizeof( print_st[ 0 ] ) * print_num_of_attr );
		memset( print_sa, 0, sizeof( print_sa[ 0 ] ) * print_num_of_attr );
		memset( print_ct, 0, sizeof( print_ct[ 0 ] ) * print_num_of_attr );
		memset( print_ca, 0, sizeof( print_ca[ 0 ] ) * print_num_of_attr );
		memset( print_SID, 0, sizeof( print_SID[ 0 ] ) * print_num_of_attr );
		memset( print_VALUE, 0, sizeof( print_VALUE[ 0 ] ) * print_num_of_attr );
		memset( print_GID, 0, sizeof( print_GID[ 0 ] ) * print_num_of_attr );
		memset( print_GDB, 0, sizeof( print_GDB[ 0 ] ) * print_num_of_attr );
		memset( print_TYPE, 0, sizeof( print_TYPE[ 0 ] ) * print_num_of_attr );
		memset( print_nm, 0, sizeof( print_nm[ 0 ] ) * print_num_of_attr );
	}
	if ( print_index > print_num_of_index ) {
		print_num_of_index = print_index;
		if ( !VD( print_as_index ) )
			free( print_as_index );
		if ( !VD( print_ac_index ) )
			free( print_ac_index );
		print_as_index = ( print_as_index_t * ) malloc( print_num_of_index * sizeof( print_as_index[ 0 ] ) );
		print_ac_index = ( print_ac_index_t * ) malloc( print_num_of_index * sizeof( print_ac_index[ 0 ] ) );
	}
	switch ( id->arr_part[ 0 ] ) {
		case 'o':
			return get_object( id );
		case 'f':
			return get_func_trace( id );
	}
	return NULL;
}


#endif /* PRINT_POG */

static int PO_type( tg )
{
	switch ( tg ) {
#ifdef INT_tag
		case INT_tag:
			return ( PO_INT );
#endif
#ifdef THREAD_ID_tag

		case THREAD_ID_tag:
			return ( PO_THREAD_ID );
#endif
#ifdef BOOL_tag

		case BOOL_tag:
			return ( PO_BOOL );
#endif
#ifdef CHAR_tag

		case CHAR_tag:
			return ( PO_CHAR );
#endif
#ifdef FLT_tag

		case FLT_tag:
			return ( PO_FLT );
#endif
#ifdef FLTD_tag

		case FLTD_tag:
			return ( PO_FLTD );
#endif
#ifdef STR_tag

		case STR_tag:
			return ( PO_STR );
#endif
#ifdef FSTR_tag

		case FSTR_tag:
			return ( PO_FSTR );
#endif

	}
	if ( tg < 0 )
		return PO_VAL;
	/* fprintf(stderr,"Index tg%d",tg);
	fprintf(stderr,"sather_types[tg]%d", (int) sather_types[tg]);
	*/
	if ( sather_types[ tg ] ->is_abstract )
		return PO_ABSTRACT | PO_REF;
	return PO_REF;
}


static void _print_O_( int type, char *sn, char *st, char *cn, char *ct, void *ob, int tg, int dec_source, int class_source, void *rob, int where )
{
	no_garbage( ob );
	if ( ob != rob )
		no_garbage( rob );
#ifdef PRINT_POG

	if ( print_in_pog ) {
		int i = print_in_pog - 1;
		if ( ( type & PO_NAME_MASK ) != PO_TITLE ) {
			print_current_line++;
			if ( print_current_line < print_start_line )
				return ;
			if ( print_current_line >= print_start_line + print_lines ) {
				print_last_line = 0;
				return ;
			}
		}
		print_sa[ i ] = sn;
		print_st[ i ] = st;
		print_ca[ i ] = cn;
		print_ct[ i ] = ct;
		print_TYPE[ i ] = type;
		if ( type & PO_ABSTRACT ) {
			print_sr[ i ] = TYPE( ob );
			print_cr[ i ] = CTYPE( ob );
		} else {
			print_sr[ i ] = print_st[ i ];
			print_sr[ i ] = print_sr[ i ];
		}
		switch ( type & PO_TYPE_MASK ) {
			case PO_INT:
				_printg_INT( *( INT* ) ob, print_VALUE[ i ] );
				break;
			case PO_BOOL:
				_printg_BOOL( *( BOOL* ) ob, print_VALUE[ i ] );
				break;
			case PO_CHAR:
				_printg_CHAR( *( CHAR* ) ob, print_VALUE[ i ] );
				break;
			case PO_FLT:
				_printg_FLT( *( FLT* ) ob, print_VALUE[ i ] );
				break;
			case PO_FLTD:
				_printg_FLTD( *( FLTD* ) ob, print_VALUE[ i ] );
				break;
			case PO_STR:
				_printg_STR( ( STR ) ob, print_VALUE[ i ] );
				if ( !VD( ob ) ) {
					_printg_SYSID( ob, print_SID[ i ] );
					_printg_GDB( ob, print_GDB[ i ] );
				}
				break;
			case PO_FSTR:
				_printg_FSTR( ( FSTR ) ob, print_VALUE[ i ] );
				if ( !VD( ob ) ) {
					_printg_SYSID( ob, print_SID[ i ] );
					_printg_GDB( ob, print_GDB[ i ] );
				}
				break;
			case PO_EXT_OB:
				if ( VD( ob ) )
					strcpy( print_VALUE[ i ], "(void)" );
				break;
			case PO_VAL:
				if ( ( type & PO_NAME_MASK ) == PO_TITLE )     /* ob is a pointer to a pointer to the object in this case */
#ifdef PSATHER

					_printg_VAL_GID( *( void ** ) rob, tg, where, print_GID[ i ] );
				else
					_printg_VAL_GID( rob, tg, where, print_GID[ i ] );
#else

					_printg_VAL_GID( *( void ** ) ob, tg, 0, print_GID[ i ] );
				else
					_printg_VAL_GID( ob, tg, 0, print_GID[ i ] );
#endif

				break;
			case PO_REF:
				if ( VD( ob ) )
					strcpy( print_VALUE[ i ], "(void)" );
				else {
					switch ( ( ( OB ) ob ) ->header.tag ) {
#ifdef THREAD_ID_tag
						case THREAD_ID_tag:
							_printg_THREAD_ID( ( ( THREAD_ID_boxed ) ob ) ->immutable_part, print_VALUE[ i ] );
							break;
#endif
#ifdef INT_tag

						case INT_tag:
							_printg_INT( ( ( INT_boxed ) ob ) ->immutable_part, print_VALUE[ i ] );
							break;
#endif
#ifdef BOOL_tag

						case BOOL_tag:
							_printg_BOOL( ( ( BOOL_boxed ) ob ) ->immutable_part, print_VALUE[ i ] );
							break;
#endif
#ifdef CHAR_tag

						case CHAR_tag:
							_printg_CHAR( ( ( CHAR_boxed ) ob ) ->immutable_part, print_VALUE[ i ] );
							break;
#endif
#ifdef FLT_tag

						case FLT_tag:
							_printg_FLT( ( ( FLT_boxed ) ob ) ->immutable_part, print_VALUE[ i ] );
							break;
#endif
#ifdef FLTD_tag

						case FLTD_tag:
							_printg_FLTD( ( ( FLTD_boxed ) ob ) ->immutable_part, print_VALUE[ i ] );
							break;
#endif
#ifdef STR_tag

						case STR_tag:
							_printg_STR( ( STR ) ob, print_VALUE[ i ] );
							break;
#endif
#ifdef FSTR_tag

						case FSTR_tag:
							_printg_FSTR( ( FSTR ) ob, print_VALUE[ i ] );
							break;
#endif

						default:
							if ( ( ( OB ) ob ) ->header.tag > 0 ) {
								_printg_SYSID( ob, print_SID[ i ] );
								_printg_REF_GID( ob, print_GID[ i ] );
							}
							_printg_GDB( ob, print_GDB[ i ] );
					}
				}
				break;
		}
		print_in_pog++;
	} else {
#endif
#define SF	if(print_declared_source && dec_source) Pr("  <%s:%d>",source_file(dec_source),source_line(dec_source)); \
		if(print_class_source && class_source) Pr("  <def:%s:%d>",source_file(class_source),source_line(class_source));

		if ( ( type & PO_NAME_MASK ) == PO_TITLE )
			return ;
		if ( print_attr ) {
			switch ( type & PO_NAME_MASK ) {
				case PO_ARG:
					Pr( "arg " );
					break;
				case PO_LOCAL:
					Pr( "local " );
					break;
				case PO_ATTR:
					if ( !VD( sn ) ? strlen( sn ) > 0 : 0 )
						Pr( "attr " );
					break;
			}
			if ( !VD( sn ) )
				Pr( sn );
		}
		if ( ( !VD( sn ) ? strlen( sn ) > 0 : 0 ) && ( print_attr && ( print_type || print_real ) ) )
			Pr( ":" );
		if ( type & PO_ABSTRACT ) {
			if ( !VD( st ) ? strlen( st ) > 0 : 0 ) {
				if ( print_type )
					Pr( st );
				if ( print_type && print_real )
					Pr( " [%s]", TYPE( ( OB ) ob ) );
				else if ( print_real ) {
					if ( VD( ob ) )
						Pr( st );
					else
						Pr( "%s", TYPE( ( OB ) ob ) );
				}
				Pr( " " );
			}
		} else {
			if ( ( !VD( st ) ? strlen( st ) > 0 : 0 ) && ( print_type || print_real ) )
				Pr( "%s ", st );
		}
		if ( print_c_type || print_c_attr || print_c_real ) {
			if ( !VD( ct ) ? strlen( ct ) > 0 : 0 ) {
				Pr( "(" );
				if ( type & PO_ABSTRACT ) {
					if ( print_c_type )
						Pr( ct );
					if ( print_c_type || print_c_real )
						Pr( " [" );
					else if ( print_c_real )
						Pr( "*" );
					if ( print_c_real )
						Pr( "%s", CTYPE( ( OB ) ob ) );
					if ( print_c_type || print_c_real )
						Pr( "]" );
					Pr( " " );
				} else {
					if ( print_c_type || print_c_attr )
						Pr( "%s ", ct );
				}
				if ( print_c_attr )
					Pr( cn );
				Pr( ")" );
			}
		}
		if ( !VD( ct ) ? ( strlen( ct ) > 0 && ( !VD( st ) ? strlen( st ) > 0 : 0 ) ) : 0 )
					Pr( ": " );

switch ( type & PO_TYPE_MASK ) {
			case PO_INT:
				_print_INT( *( INT* ) ob );
				SF;
				Pr( "\n" );
				break;
			case PO_BOOL:
				_print_BOOL( *( BOOL* ) ob );
				SF;
				Pr( "\n" );
				break;
			case PO_CHAR:
				_print_CHAR( *( CHAR* ) ob );
				SF;
				Pr( "\n" );
				break;
			case PO_FLT:
				_print_FLT( *( FLT* ) ob );
				SF;
				Pr( "\n" );
				break;
			case PO_FLTD:
				_print_FLTD( *( FLTD* ) ob );
				SF;
				Pr( "\n" );
				break;
			case PO_STR:
				_print_STR( ( STR ) ob );
				SF;
				Pr( "\n" );
				break;
			case PO_FSTR:
				_print_FSTR( ( FSTR ) ob );
				SF;
				Pr( "\n" );
				break;
			case PO_EXT_OB:
				if ( VD( ob ) )
					Pr( "  (void)" );
				SF;
				Pr( "\n" );
				break;
			case PO_VAL:
				SF;
#ifdef PSATHER

				if ( print_gdb )
					Pr( "   p POV(0x%x,%d,%d)", SENDFOBHOME( rob ), tg, where );
#else

				if ( print_gdb )
					Pr( "   p POV(0x%x,%d)", ob, tg );
#endif

				Pr( "\n" );
				if ( print_depth > 1 ) {
					print_depth--;
					print_Type( ob, tg );
					print_depth++;
				}
				break;
			case PO_REF:
				if ( VD( ob ) ) {
					Pr( "  (void)" );
					SF;
					Pr( "\n" );
				} else {
#ifdef PSATHER
					SAFE_POS
#endif
					if ( GET_TAG( ob ) > 0 ) {
						if ( print_id )
							Pr( "  [ID %d]", SID( ob ) );
						if ( print_pointer )
							Pr( "  [C 0x%x]", ob );
					}
#ifdef PSATHER
					RESTORE_POS
#endif

					SF;
					/*
					#ifdef PSATHER
										if(print_gdb) Pr("  p PO(0x%x)",rob);
					#else
					*/
					if ( print_gdb )
						Pr( "  p PO(0x%x)", ob );
					/*
					#endif
					*/
					Pr( "\n" );
					if ( print_depth > 1 ) {
						print_depth--;
						print_Type( ( OB ) ob, 0 );
						print_depth++;
					}
				}
				break;
		}
#ifdef PRINT_POG

	}
#endif
}

static int _print_A_( int type, char *st, char *ct, int size, int elsize, void *arr, int tg, int source, void *rob, int where )
{
#ifdef PRINT_POG
	if ( print_in_pog ) {
		int i = print_in_pog - 1;
		if ( ( type & PO_NAME_MASK ) != PO_TITLE ) {
			print_current_line++;
			if ( print_current_line >= print_start_line + print_lines ) {
				print_last_line = 0;
				return ;
			}
			if ( !( print_current_line < print_start_line ) ) {
				int i;
				i = print_in_pog - 1;
				print_sa[ i ] = "[]";
				print_sr[ i ] = print_st[ i ] = st;
				print_cr[ i ] = print_ct[ i ] = ct;
				print_ca[ i ] = "[]";
				print_TYPE[ i ] = PO_ARRAY;
				sprintf( print_VALUE[ i ], "size %d", size );
				print_in_pog++;
			}
		}
		switch ( type & PO_TYPE_MASK ) {
			case PO_INT:
				return print_in_pog = 1 + _printg_INT_arr( ( INT* ) arr, size, print_in_pog - 1 );
				break;
			case PO_BOOL:
				return print_in_pog = 1 + _printg_BOOL_arr( ( BOOL* ) arr, size, print_in_pog - 1 );
				break;
			case PO_CHAR:
				return print_in_pog = 1 + _printg_CHAR_arr( ( CHAR* ) arr, size, print_in_pog - 1 );
				break;
			case PO_FLT:
				return print_in_pog = 1 + _printg_FLT_arr( ( FLT* ) arr, size, print_in_pog - 1 );
				break;
			case PO_FLTD:
				return print_in_pog = 1 + _printg_FLTD_arr( ( FLTD* ) arr, size, print_in_pog - 1 );
				break;
			case PO_STR:
				return print_in_pog = 1 + _printg_STR_arr( ( STR * ) arr, size, print_in_pog - 1, st, ct );
				break;
			case PO_FSTR:
				return print_in_pog = 1 + _printg_FSTR_arr( ( FSTR * ) arr, size, print_in_pog - 1, st, ct );
				break;
			case PO_VAL:
				return print_in_pog = 1 + _printg_VAL_arr( arr, size, elsize, print_in_pog - 1, st, ct, tg, rob, where );
				break;
			case PO_REF:
				return print_in_pog = 1 + _printg_REF_arr( arr, size, print_in_pog - 1, st, ct );
				break;
		}
	} else {
#endif
		Pr( "array of " );
		if ( print_type || print_real )
			Pr( "%s ", st );
		if ( print_c_type || print_c_real )
			Pr( "(%s) ", ct );
		Pr( ", size %d", size );
		if ( print_class_source && source )
			Pr( " def:%s:%d", source_file( source ), source_line( source ) );
		Pr( " :\n" );

		switch ( type & PO_TYPE_MASK ) {
			case PO_INT:
				_print_INT_arr( ( INT* ) arr, size );
				break;
			case PO_BOOL:
				_print_BOOL_arr( ( BOOL* ) arr, size );
				break;
			case PO_CHAR:
				_print_CHAR_arr( ( CHAR* ) arr, size );
				break;
			case PO_FLT:
				_print_FLT_arr( ( FLT* ) arr, size );
				break;
			case PO_FLTD:
				_print_FLTD_arr( ( FLTD* ) arr, size );
				break;
			case PO_STR:
				_print_STR_arr( ( STR * ) arr, size );
				break;
			case PO_FSTR:
				_print_FSTR_arr( ( FSTR * ) arr, size );
				break;
			case PO_VAL:
				_print_VAL_arr( arr, size, elsize, tg, rob, where );
				break;
			case PO_REF:
				_print_REF_arr( arr, size );
				break;
		}
#ifdef PRINT_POG

	}
#endif
}


static void print_Func( struct _func_frame *rf, int where )
{
	int i, s;
	int a, l;
	void **p, *oa;
	struct _func_frame *f, fm;
	struct sather_function_definition *sf;
#ifdef PSATHER

	if ( where == HERE )
		f = rf;
	else
	{
		get_memory_from( &fm, where, rf, sizeof( fm ) );
		a = sather_functions[ fm.func ] ->args;
		l = sather_functions[ fm.func ] ->locals;
		f = &fm;
		oa = f->args;
		f->args = ( void ** ) malloc( sizeof( void * ) * ( a + l ) );
		get_memory_from( f->args, where, oa, sizeof( void * ) * ( a + l ) );
	}
#else
	f = rf;
#endif

	sf = sather_functions[ f->func ];
	FUNC( f );
	if ( VD( f->args ) )
		return ;
	print_depth--;
	for ( i = 0;print_depth >= 0 && i < sf->args + sf->locals;i++ )
	{
#ifdef PSATHER
		if ( HERE != where ) {
			if ( sather_types[ sf->attr[ i ].type ] ->is_immutable ) {
				s = sather_types[ sf->attr[ i ].type ] ->size;
				p = ( void ** ) malloc( s );
				get_memory_from( p, where, f->args[ i ], s );
				RECVOB( sf->attr[ i ].type, p, where );
			} else {
				get_memory_from( &p, where, f->args[ i ], sizeof( FOB ) );
				p = RECVFOB( p, where );
			}
		} else {
#endif
			if ( sather_types[ sf->attr[ i ].type ] ->is_immutable )
				p = f->args[ i ];
			else
				p = *( void ** ) f->args[ i ];
#ifdef PSATHER

		}
#endif

		_print_O_( PO_type( sf->attr[ i ].type ) | ( i < sf->args ? PO_ARG : PO_LOCAL ),
		           sf->attr[ i ].sather_name, sather_types[ sf->attr[ i ].type ] ->sather_name,
		           sf->attr[ i ].c_name, sather_types[ sf->attr[ i ].type ] ->c_name,
		           p,
		           sf->attr[ i ].type < 0 ? sf->attr[ i ].type : 0, sf->attr[ i ].source,
		           sather_types[ sf->attr[ i ].type ] ->source,
#ifdef PSATHER
		           f->args[ i ], where );
#else

				   0, 0 );
#endif

	}
	print_depth++;
}

#ifdef PSATHER
static void *get_remote_object( void *p, int where, int t, int boxed )
{
	void * ob;
	int elsize, memsize, arr_offset, as, a;
	struct sather_type_description *s;
	memsize = sather_types[ t ] ->size;
	s = sather_types[ t ];
	if ( s->is_aref && s->is_ref ) {
		as = read_asize( RECVFOB( p, where ) + s->attr[ s->attrs ].offset );
		arr_offset = s->attr[ s->attrs + 1 ].offset;
		elsize = sather_types[ s->attr[ s->attrs + 1 ].type ] ->size;
		if ( sather_types[ s->attr[ s->attrs + 1 ].type ] ->is_immutable )
			memsize += as * elsize;
		else
			memsize += as * sizeof( FOB );
	} else {
		arr_offset = s->size;
	}
	if ( s->is_immutable && boxed )
		memsize += s->boxed;

	ob = malloc( memsize ); /* supposedly garbage collected */
	get_memory_from( ob, where, p, memsize );
	RECVOB( boxed ? 0 : t, ob, where );

	return ob;
}
#endif

static void print_VType( OB rob, int tg, int w )
{
#ifdef PSATHER
	if ( w != HERE )
		rob = get_remote_object( rob, w, tg, 0 );
#endif

	print_Type( rob, tg );
}
static void print_Type( OB rob, int tg )
{
	int type;
	int a, i;
	struct sather_type_description *st;
	OB ob;
	int where = 0;
#ifdef PSATHER

	if ( FVOID( rob ) || NEAR( rob ) || tg != 0 ) {
		/* tg!=0 ==> value object, by definition NEAR */
		where = HERE;
		ob = rob;
		if ( FVOID( rob ) )
			ob = NULL;
	} else {
		int t, s, as;
		where = WHERE( rob );
		t = GET_TAG( rob );
		ob = get_remote_object( SENDFOBHOME( rob ), where, t, 1 );
		no_garbage( rob );
	}
#else
	ob = rob;
#endif

	no_garbage( ob );

	if ( tg >= 0 ) {
		tg = ob->header.tag;
		if ( tg < 0 )    /* boxed type */
			ob = ( OB ) ( ( ( char * ) ob ) + sather_types[ tg ] ->boxed );
	}
	st = sather_types[ tg ];

	type = PO_TITLE | PO_type( tg );
	_print_O_( type, "", st->sather_name, "", st->sather_name, ob, 0, 0, st->source, 0, 0 );
	a = st->attrs;

	switch ( tg ) {
#ifdef THREAD_ID_tag
		case THREAD_ID_tag:
			_print_O_( PO_THREAD_ID | PO_ATTR, "", "", "", "", ob, THREAD_ID_tag, 0, 0, 0, 0 );
			break;
#endif
#ifdef INT_tag

		case INT_tag:
			_print_O_( PO_INT | PO_ATTR, "", "", "", "", ob, INT_tag, 0, 0, 0, 0 );
			break;
#endif
#ifdef BOOL_tag

		case BOOL_tag:
			_print_O_( PO_BOOL | PO_ATTR, "", "", "", "", ob, BOOL_tag, 0, 0, 0, 0 );
			break;
#endif
#ifdef CHAR_tag

		case CHAR_tag:
			_print_O_( PO_CHAR | PO_ATTR, "", "", "", "", ob, CHAR_tag, 0, 0, 0, 0 );
			break;
#endif
#ifdef FLT_tag

		case FLT_tag:
			_print_O_( PO_FLT | PO_ATTR, "", "", "", "", ob, FLT_tag, 0, 0, 0, 0 );
			break;
#endif
#ifdef FLTD_tag

		case FLTD_tag:
			_print_O_( PO_FLTD | PO_ATTR, "", "", "", "", ob, FLTD_tag, 0, 0, 0, 0 );
			break;
#endif
#ifdef STR_tag

		case STR_tag:
			_print_O_( PO_STR | PO_ATTR, "", "", "", "", ob, STR_tag, 0, 0, 0, 0 );
			break;
#endif
#ifdef FSTR_tag

		case FSTR_tag:
			_print_O_( PO_FSTR | PO_ATTR, "", "", "", "", ob, FSTR_tag, 0, 0, 0, 0 );
			break;
#endif

		default:
			for ( i = 0;i < a;i++ ) {
				void **p = ( void * ) ( ( ( char * ) ob ) + st->attr[ i ].offset );
				void **rp = ( void * ) ( ( ( char * ) rob ) + st->attr[ i ].offset );
				_print_O_( PO_type( st->attr[ i ].type ) | PO_ATTR,
				           st->attr[ i ].sather_name, sather_types[ st->attr[ i ].type ] ->sather_name,
				           st->attr[ i ].c_name, sather_types[ st->attr[ i ].type ] ->c_name,
				           sather_types[ st->attr[ i ].type ] ->is_immutable ? p : *p,
				           st->attr[ i ].type < 0 ? st->attr[ i ].type : 0, st->attr[ i ].source,
				           sather_types[ st->attr[ i ].type ] ->source,
#ifdef PSATHER
				           SENDFOBHOME( rp ), where );
#else

						   0, 0 );
#endif

			}
			if ( st->is_aref ) {
				struct sather_attribute * s = st->attr + st->attrs;
				struct sather_attribute *ar = st->attr + st->attrs + 1;
				_print_A_( PO_type( ar->type ),
				           sather_types[ ar->type ] ->sather_name,
				           sather_types[ ar->type ] ->c_name,
				           sather_types[ tg ] ->is_immutable ? s->offset : *( INT * ) ( ( char * ) ob + s->offset ),
				           sather_types[ ar->type ] ->is_immutable ? sather_types[ ar->type ] ->size : sizeof( OB ),
				           ( void * ) ( ( ( char * ) ob ) + ar->offset ), ar->type, sather_types[ ar->type ] ->source,
#ifdef PSATHER
				           ( void * ) ( ( ( char * ) rob ) + ar->offset ), where
#else
						   0, 0
#endif
				         );
			}
	}
}

#ifdef PSATHER
static void wait_for_tid( int from, LOCAL_MEM l, long res )
{
	while ( !l->got_tid )
		SYS_DEFER;
	BR_REQUEST_1( from, r_ta_sema_signal, res );
}
#endif
static void get_prev_frame( struct _func_frame *f, int where,
                            struct _func_frame **n, int *nwhere )
{
#ifdef PSATHER
	if ( where == HERE )
		f = f->prev;
	else
		get_memory_from( &f, where, &f->prev, sizeof( f ) );
	if ( ( long ) f&1 )
	{ /* we hit a local memory pointer */
		TA_SEMAPHORE( ta );
		LOCAL_MEM l = ( LOCAL_MEM ) ( ( long ) f - 1 );
		/* wait for the necessary info */
		BR_FORK_2( where, ( BR_handler_2_t ) wait_for_tid, ( long ) l, ( long ) ta );
		TA_SEMA_WAIT( ta );
		if ( where != HERE ) {
			get_memory_from( &f, where, &l->prev_FF, sizeof( f ) );
			get_memory_from( &where, where, &l->prev_cluster, sizeof( where ) );
		} else {
			where = l->prev_cluster;
			f = l->prev_FF;
		}
	}
#else
	f = f->prev;
#endif

	*nwhere = where;
	*n = f;
}

/*
 * Print Function Backtrace starting at f
 */
static void FUNC( struct _func_frame *f )
{
	char *p;
	char c[ 9 ];
	int i;
	p = sather_functions[ f->func ] ->sather_name;
#ifdef PRINT_POG

	if ( print_in_pog )
	{
		print_sa[ 0 ] = p;
		sprintf( print_GID[ 0 ], "o_0x%x_0x%x_0_0", print_Func, f );
		print_TYPE[ 0 ] = PO_FUNC;
		print_in_pog++;
	} else
	{
#endif
		Pr( "%s", p );
		if ( print_declared_source )
			Pr( "  <%s:%d>", source_file( sather_functions[ f->func ] ->source ), source_line( sather_functions[ f->func ] ->source ) );
		Pr( "\n" );
#ifdef PRINT_POG

	}
#endif
}

void PFR( struct _func_frame *f, int where )
{
	print_orig_depth = print_depth;
	print_need_indent = 1;
	ON_SIGNAL
#ifdef PSATHER
	if ( ( ( long ) f ) &1 )
	{
		struct _func_frame ff;
		ff.prev = f;
		get_prev_frame( &ff, HERE, &f, &where );
	}
#endif
	if ( VD( f ) )
	{
		Pr( "NULL\n" );
		return ;
	}
	print_Func( f, where );
	if ( !VD( f->prev ) )
	{
#ifdef PSATHER
		struct _func_frame * pr;
		get_prev_frame( f, where, &pr, &where );
		if ( where != HERE )
			Pr( "next frame: p PFR(0x%x,%d)\n", pr, where );
		else
			Pr( "next frame: p PF(0x%x)\n", pr );
#else

		Pr( "next frame: p PF(0x%x)\n", f->prev );
#endif

	} else
		Pr( "BOTTOM\n" );
	ON_SIGNAL_DO
	ON_SIGNAL_END
}
void PF( struct _func_frame *f )
{
#ifdef PSATHER
	PFR( f, HERE );
#else

	PFR( f, 0 );
#endif
}
void *PFSTR( struct _func_frame *f )
{
	print_str = 1;
	str_buf = ( STR ) rt_arr_alloc( sizeof( STR ), STR_tag, 1, 500 );
	str_buf->asize = 500;
	cur_str_pos = str_buf->arr_part;
	PF( f );
	print_str = 0;
	str_buf->asize = strlen( str_buf->arr_part );
	return str_buf;
}

void PTR( struct _func_frame *f, int where )
{
	int i;
	print_orig_depth = print_depth;
	print_need_indent = 1;
	ON_SIGNAL
#ifdef PSATHER
	if ( ( ( long ) f ) &1 )
	{
		struct _func_frame ff;
		ff.prev = f;
		get_prev_frame( &ff, HERE, &f, &where );
	}
#endif
	if ( VD( f ) )
	{
		Pr( "BOTTOM\n" );
		return ;
	}
	for ( i = 0;i < print_func && !VD( f );i++ )
	{
#ifdef PSATHER
		if ( where != HERE ) {
			int fi;
			get_memory_from( &fi, where, &f->func, sizeof( fi ) );
			Pr( "%s", sather_functions[ fi ] ->sather_name );
			if ( print_declared_source )
				Pr( "  <%s:%d>", source_file( sather_functions[ fi ] ->source ), source_line( sather_functions[ fi ] ->source ) );
			if ( print_gdb )
				Pr( "  p PFR(0x%x,%d)", f, where );
		} else {
#endif
			Pr( "%s", sather_functions[ f->func ] ->sather_name );
			if ( print_declared_source )
				Pr( "  <%s:%d>", source_file( sather_functions[ f->func ] ->source ), source_line( sather_functions[ f->func ] ->source ) );
			if ( print_gdb )
				Pr( "  p PF(0x%x)", f );
#ifndef PSATHER

			f = f->prev;
#else

		}
		get_prev_frame( f, where, &f, &where );
#endif

			Pr( "\n" );
		}
#ifdef PSATHER
		if ( !VD( f ) && print_gdb )
		{
			if ( HERE == where )
				Pr( "p PT(0x%x)\n", f );
			else
				Pr( "p PTR(0x%x,%d)\n", f, where );
		}
#else
		if ( !VD( f ) && print_gdb )
			Pr( "p PT(0x%x)\n", f );
#endif

		else
			Pr( "BOTTOM\n" );
		ON_SIGNAL_DO
		ON_SIGNAL_END
	}

	void PT( struct _func_frame *f )
	{
#ifdef PSATHER
		PTR( f, HERE );
#else

		PTR( f, 0 );
#endif

	}
	void *PTSTR( struct _func_frame *f )
	{
		print_str = 1;
		str_buf = ( STR ) rt_arr_alloc( sizeof( STR ), STR_tag, 1, 500 );
		str_buf->asize = 500;
		cur_str_pos = str_buf->arr_part;
		PT( f );
		print_str = 0;
		str_buf->asize = strlen( str_buf->arr_part );
		return str_buf;
	}

	extern void start_gdb( void );
	int rt_fatal_po(
#ifdef S_DEBUG
	    char *file, int line,
#endif
	    char *msg, struct _func_frame *f )
	{
		int pg;
#ifdef S_DEBUG

		fprintf( stderr, "%s:%d:", file, line );
#endif

		fprintf( stderr, "%s\n", msg );
		fflush( stderr );
		printf( "------------------------------------\ncurrent function frame:\n" );
		pg = print_gdb;
		if ( getenv( "START_GDB" ) == NULL )
			print_gdb = 0;
		PF( f );
		printf( "------------------------------------\nbacktrace:\n" );
		PT( f );
		printf( "------------------------------------\n" );
		print_gdb = pg;
		fflush( stdout );
#ifdef START_GDB

		start_gdb();
#endif

		abort();
	}

	int rt_fatal_2_po(
#ifdef S_DEBUG
	    char *file, int line,
#endif
	    char *msg, char *str, struct _func_frame *f )
	{
		int pg;
#ifdef S_DEBUG

		fprintf( stderr, "%s:%d:", file, line );
#endif

		fprintf( stderr, "%s, %s\n", msg, str );
		fflush( stderr );
		printf( "------------------------------------\ncurrent function frame:\n" );
		pg = print_gdb;
		if ( getenv( "START_GDB" ) == NULL )
			print_gdb = 0;
		PF( f );
		printf( "------------------------------------\nbacktrace:\n" );
		PT( f );
		print_gdb = pg;
		printf( "------------------------------------\n" );
		fflush( stdout );
#ifdef START_GDB

		start_gdb();
#endif

		abort();
	}


	/*
	 * returns the C function of all Sather function starting
	 * with the string passed in as argument.
	 * Meant to be called from gdb
	 */
	static void C( char *s )
	{
		int i;
		for ( i = 0;!VD( sather_functions[ i ] );i++ )
			if ( strncmp( s, sather_functions[ i ] ->sather_name, strlen( s ) ) == 0 )
				printf( "%-32s %s\n", sather_functions[ i ] ->c_name, sather_functions[ i ] ->sather_name );
	}

	/*
	 * Giving a C function returns the Sather function 
	 * Meant to be called from gdb
	 */
	/* Well, S is a macro in pSather.h, so we undefine it here */
#ifdef S
#undef S
#endif
	static void S( void ( *f ) () )
	{
		int i;
		for ( i = 0;!VD( sather_functions[ i ] );i++ )
			if ( sather_functions[ i ] ->cfunc == f ) {
				printf( "%-32s %s\n", sather_functions[ i ] ->c_name, sather_functions[ i ] ->sather_name );
				return ;
			}
	}

