/*------------------------->  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 <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 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
{ 
	va_list ap;
	char *f;
#ifdef STR_tag
	int cur_size;
	STR n;
#endif
	va_start(ap);
	f=va_arg(ap,char*);
	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
	}
}

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;
		}
}

