/*************************************************************************
*  PDSS (PIMOS Development Support System)  Version 2.52		 *
*  (C) Copyright 1988,1989,1990,1992.					 *
*  Institute for New Generation Computer Technology (ICOT), Japan.	 *
*  Read "../COPYRIGHT" for detailed information.			 *
*************************************************************************/

#include  "pdss.h"
#include  "memory.h"
#include  "io.h"
#include  "klb.h"

static FILE *file = stdout;
static int  deadlock = NO;
static int  var_mode = PRINT_VAR_MODE_ABC;
static int  length;

static CHAR *lookup_var_name();
static CHAR *gen_name();
extern CELL *lookup_var();

#define Deref1(c, res){\
    res = c;\
    while(Typeof(res)==REF) res = Objectof(res);\
}
#define Deref2(c, res, ref, mrb){\
    res = ref = c;  mrb = MRBOFF;\
    while(Typeof(res)==REF){\
	if(Mrbof(res)==MRBON){\
	    mrb = MRBON;\
	    do { res = Objectof(ref = res); } while(Typeof(res)==REF);\
	    break;\
	}\
	res = Objectof(ref = res);\
    }\
    if(!IsUnbound(res) && Mrbof(res)==MRBON) mrb = MRBON;\
}


/*************************************************************************
*   Initialize Print Routine.						 *
*************************************************************************/

initialize_print_routine()
{
    initializr_var_table();
}

set_print_file(ff)
    FILE *ff;
{
    file = ff;
}

/*
PRINT_VAR_MODE_ABC = 0 -> Use temporary name. A,B,C,...
PRINT_VAR_MODE_ADR = 1 -> Use variable address.
*/
set_print_var_mode(mode)
    int	 mode;
{
    var_mode = mode;
}

int get_print_var_mode()
{
    return(var_mode);
}

/*
YES -> Mode for deadlock message. Use value of UNDEF cell as variable type.
NO  -> Mode for normal message.
*/
set_print_deadlock(f)
    int	 f;
{
    deadlock = f;
}


/*************************************************************************
*   Print Term for Debugger -- Main.					 *
*************************************************************************/

print_term(cc, len, depth)
    CELL *cc;
    int	 len, depth;
{
    CELL *c, *r;
    int	 mrb;

    file = stdout;
    length = len;
    initialize_print_routine();
    Deref2(cc, c, r, mrb);
    if(print_sub(c, r, mrb, depth) && mrb==MRBON && !deadlock){
	putc('x', file);
    }
}

print_term2(cc, len, depth)
    CELL *cc;
    int	 len, depth;
{
    CELL *c, *r;
    int	 mrb;

    file = stdout;
    length = len;
    Deref2(cc, c, r, mrb);
    if(print_sub(c, r, mrb, depth) && mrb==MRBON && !deadlock){
	putc('x', file);
    }
}

fprint_term(ff, cc, len, depth)
    FILE *ff;
    CELL *cc;
    int	 len, depth;
{
    CELL *c, *r;
    int	 mrb;

    file = ff;
    length = len;
    initialize_print_routine();
    Deref2(cc, c, r, mrb);
    if(print_sub(c, r, mrb, depth) && mrb==MRBON && !deadlock){
	putc('x', file);
    }
}


/*************************************************************************
*   Print Term for Debugger -- Subroutine.				 *
*************************************************************************/

static int print_sub(c, r, mrb, depth)
    CELL *c, *r;
    int	 mrb, depth;
{
    int	 mrb2, win;

    switch(Typeof(c)){
      case UNDEF:
	if(deadlock){
	    if(Valueof(c)==HOOK || Valueof(c)==MHOOK) goto deadlock_hook;
	    if(Valueof(c)==MGHOK) goto deadlock_mghok;
	}
	fprintf(file, "%s", lookup_var_name(c, r));
	return(YES);
      case HOOK:
      case MHOOK:
      deadlock_hook:
	fprintf(file, "%s~", lookup_var_name(c, r));
	return(YES);
      case MGHOK:
      deadlock_mghok:
	fprintf(file, "%s^", lookup_var_name(c, r));
	return(YES);
      /**********************
	Deref2(MergerTail(c), c, r, mrb2);
	if(print_sub(c, r, mrb2, depth) && mrb2==MRBON && !deadlock){
	    putc('x', file);
	}
	putc('^', file);
	return(YES);
      **********************/
      case ATOM:
	fprintf(file, "%s", atom_name(Valueof(c)));
	return(NO);
      case INT:
	fprintf(file, "%d", Valueof(c));
	return(NO);
      case FLOAT:
	fprintf(file, "%s", float_to_string(&Valueof(c)));
	return(NO);
      case LIST:
	print_list(c, depth, mrb);
	return(YES);
      case VECTOR:
	print_vector(c, depth, mrb);
	return(YES);
      case STRING:
	if((StringTypeof(c)&0xE7) == 0x03){
	    putc('"', file);
	    fprint_string2(file, c);
	    putc('"', file);
	}else{
	    print_nbit_string(c);
	}
	return(YES);
      case NUE:
	print_nue(c, depth, mrb);
	return(YES);
      case SHOEN:
	fprintf(file, "$SHOEN#%d", Shoenof(c)->id);
	return(YES);
      default:
	win = current_window;
	SelectWindow(CONSOLE);
	printf("Illegal data type occurred(Tag: 0x%x  Value: 0x%x)\n", 
	       Typeof(c), Valueof(c));
	if(win >= 0) SelectWindow(win);
	return(NO);
    }
}


/*************************************************************************
*   Print List for Debugger.						 *
*************************************************************************/

static print_list(c, depth, mrb1)
    CELL *c;
    int	 depth, mrb1;
{
    register CELL *p, *r;
    register int  len, mrb2;

    p=Objectof(c);
    len=length;
    putc('[', file);
    for(;;){
	if(len<=0 || depth<=0){
	    fprintf(file, "...");
	    break;
	}
	Deref2(p++, c, r, mrb2);
	if(print_sub(c, r, mrb1|mrb2, depth-1) && mrb1==MRBOFF
					       && mrb2==MRBON && !deadlock){
	    putc('x', file);
	}
	Deref2(p++, c, r, mrb2);
	if(Typeof(c)==LIST && !(mrb1==MRBOFF && mrb2==MRBON && !deadlock)){
	    putc(',', file);
	    len--;
	    p=Objectof(c);
	    mrb1|=mrb2;
	    continue;
	}else if((Typeof(c)==ATOM) && (Valueof(c)==NIL)){
	    break;
	}else{
	    putc('|', file);
	    if(print_sub(c,r,mrb1|mrb2,depth-1) && mrb1==MRBOFF
						&& mrb2==MRBON && !deadlock){
		putc('x', file);
	    }
	    break;
	}
    }
    putc(']', file);
}


/*************************************************************************
*   Print Vector for Debugger.						 *
*************************************************************************/

static print_vector(c, depth, mrb1)
    CELL *c;
    int	 depth, mrb1;
{
    register CELL *p, *r;
    register int  i, size, len, mrb2;

    if((size=VectorLengthof(c))==0){
	fprintf(file, "{}");
	return;
    }
    p=Objectof(c)+1;
    len=length;
    Deref1(p, c);
    if(size>=2 && Typeof(c)==ATOM && Valueof(c)!=NIL){
	if(size==3 && Valueof(c)==ATOM_COLON){
	    Deref2(++p, c, r, mrb2);
	    if(print_sub(c,r,mrb1|mrb2,depth-1) && mrb1==MRBOFF
						&& mrb2==MRBON && !deadlock){
		putc('x', file);
	    }
	    putc(':', file);
	    Deref2(++p, c, r, mrb2);
	    if(print_sub(c,r,mrb1|mrb2,depth-1) && mrb1==MRBOFF
						&& mrb2==MRBON && !deadlock){
		putc('x', file);
	    }
	    return;
	}
	if(Valueof(c)==ATOM_COMMA){
	    fprintf(file, "(");
	}else{
	    fprintf(file, "%s(", atom_name(Valueof(c)));
	}
	for(i=2;; i++){
	    if(len<=0 || depth<=0){
		fprintf(file, "...");
		break;
	    }
	    Deref2(++p, c, r, mrb2);
	    if(print_sub(c,r,mrb1|mrb2,depth-1) && mrb1==MRBOFF
						&& mrb2==MRBON && !deadlock){
		putc('x', file);
	    }
	    if(i>=size) break;
	    putc(',', file);
	    len--;
	}
	putc(')', file);
	return;
    }else{
	putc('{', file);
	for(i=1;; i++){
	    if(len<=0 || depth<=0){
		fprintf(file, "...");
		break;
	    }
	    Deref2(p++, c, r, mrb2);
	    if(print_sub(c,r,mrb1|mrb2,depth-1) && mrb1==MRBOFF
						&& mrb2==MRBON && !deadlock){
		putc('x', file);
	    }
	    if(i>=size) break;
	    putc(',', file);
	    len--;
	}
	putc('}', file);
	return;
    }
}


/*************************************************************************
*   Print N bits String for Debugger.					 *
*************************************************************************/

static print_nbit_string(c)
    CELL *c;
{
    register CELL *p;
    register int  i, data, mask, elms, leng, type, width, rest, len;

    leng = StringLengthof(c);
    type = StringTypeof(c);
    width = (1<<(type&7))+(type>>(8-(type&7)));
    mask = ((unsigned int)0xFFFFFFFF)>>(32-width);
    elms = 32/width;
    rest = (type&(0xFF>>(type&7)))>>3;
    p = Objectof(c)+1;
    len = length;
    fprintf(file, "$STRING#%d{", width);
    if(leng > 0){
	while(leng-- > 1){
	    data = Valueof(p++);
	    for(i = 1;; i++){
		if(len-- <= 0){
		    fprintf(file, "...");
		    goto exit_string;
		}
		fprintf(file, "%u,", data&mask);
		if(i >= elms) break;
		data = data>>width;
	    }
	}
	elms -= rest;
	data = Valueof(p);
	for(i = 1;; i++){
	    if(len-- <= 0){
		fprintf(file, "...");
		goto exit_string;
	    }
	    fprintf(file, "%u", data&mask);
	    if(i >= elms) break;
	    putc(',', file);
	    data = data>>width;
	}
    }
  exit_string:
    putc('}', file);
}


/*************************************************************************
*   Print String for Debugger.						 *
*************************************************************************/

print_string(c)
    CELL *c;
{
    fprint_string(stdout, c);
}

fprint_string(f, c)
    register FILE *f;
    register CELL *c;
{
    register int  chars, leng, leng2;

    leng=StringLengthof(c);
    leng2=(StringTypeof(c)>>3)&3;
    c=Objectof(c)+1;
    while(leng-- > 1){
	chars=Valueof(c++);
	putc(chars&0xFF, f);
	putc((chars>>8)&0xFF, f);
	putc((chars>>16)&0xFF, f);
	putc((chars>>24)&0xFF, f);
    }
    if(leng>=0){
	chars=Valueof(c);
	putc(chars&0xFF, f);
	if(leng2<3){
	    putc((chars>>8)&0xFF, f);
	    if(leng2<2){
		putc((chars>>16)&0xFF, f);
		if(leng2<1){
		    putc((chars>>24)&0xFF, f);
		}
	    }
	}
    }
}

#define PUtC(c, f){\
    if(last == (c) && (last&0x80) == 0){  /* Kanji? */\
	cunt++;\
    }else{\
	if(cunt <= 7){\
	    while(cunt--) putc2(last, f);\
	}else{\
	    putc2(last, f); putc2(last, f);\
	    putc('.', f); putc('.', f); putc('.', f);\
	    putc2(last, f); putc2(last, f);\
	}\
	last = (c);\
	cunt = 1;\
    }\
}

static fprint_string2(f, c)
    register FILE *f;
    register CELL *c;
{
    register int  chars, leng, leng2, last, cunt;

    last = -1; cunt = 0;
    leng=StringLengthof(c);
    leng2=(StringTypeof(c)>>3)&3;
    c=Objectof(c)+1;
    while(leng-- > 1){
	chars=Valueof(c++);
	PUtC(chars&0xFF, f);
	PUtC((chars>>8)&0xFF, f);
	PUtC((chars>>16)&0xFF, f);
	PUtC((chars>>24)&0xFF, f);
    }
    if(leng>=0){
	chars=Valueof(c);
	PUtC(chars&0xFF, f);
	if(leng2<3){
	    PUtC((chars>>8)&0xFF, f);
	    if(leng2<2){
		PUtC((chars>>16)&0xFF, f);
		if(leng2<1){
		    PUtC((chars>>24)&0xFF, f);
		}
	    }
	}
    }
    PUtC(-1, f);
}

static putc2(c, f)
    int c;
    FILE *f;
{
    if(c == 0x7F){
	putc('^', f);
	putc('?', f);
    }else if(c < ' ' && c != 7){
	putc('^', f);
	putc(c+'@', f);
    }else{
	putc(c, f);
    }
}


/*************************************************************************
*   Print Nue for Debugger.						 *
*************************************************************************/

static print_nue(c, depth, mrb1)
    CELL *c;
    int	 depth, mrb1;
{
    register CELL *p, *r;
    register int  i, size, siz2, len, mrb2;

    size=NueLengthof(c);
    siz2=NueCellsof(c);
    if(siz2==0){
	fprintf(file, "$NUE#0.%d{}", size);
	return;
    }
    p=Objectof(c)+1;
    len=length;
    size-=siz2;
    fprintf(file, "$NUE#%d.%d{", siz2, size);
    for(i=1;; i++){
	if(len<=0 || depth<=0){
	    fprintf(file, "...");
	    break;
	}
	Deref2(p++, c, r, mrb2);
	if(print_sub(c,r,mrb1|mrb2,depth-1) && mrb1==MRBOFF
					    && mrb2==MRBON && !deadlock){
	    putc('x', file);
	}
	if(i>=siz2) break;
	putc(',', file);
	len--;
    }
    putc('}', file);
    return;
}


/*************************************************************************
*   Variable Table for Debug Printer.					 *
*************************************************************************/

#define TABLE_SIZE 64
#define HashIndex(var) ((int)(var) & (TABLE_SIZE-1))

struct var_number_backet{
    CELL *var;
    CELL *ref;
    int	 var_number;
    int	 rel_addr;
    struct var_number_backet  *next;
};

static struct var_number_backet *var_number_table[TABLE_SIZE];
static int  var_counter;

static initializr_var_table()
{
    register int  i;
    var_counter=0;
    for(i=0; i<TABLE_SIZE; i++){
	var_number_table[i]=NULL;
    }
    t1_free();
}

static CHAR *lookup_var_name(c, r)
    register CELL *c, *r;
{
    register struct var_number_backet *backet;
    int	 index;
    static CHAR name[16];
    CHAR *gen_name();

    index=HashIndex(c);
    for(backet=var_number_table[index]; backet; backet=backet->next){
	if(backet->var==c) goto found;
    }
    backet=(struct var_number_backet *)
	t1_alloc(sizeof(struct var_number_backet));
    backet->next=var_number_table[index];
    var_number_table[index]=backet;
    backet->var=c;
    backet->ref=r;
    backet->var_number=var_counter++;
    backet->rel_addr=c-heap1;
  found:
    if(var_mode){   /*** Address Mode ***/
	sprintf(name, "_%d", backet->rel_addr);
	return(name);
    }else{	   /*** Temporary Name Mode ***/
	return(gen_name(backet->var_number));
    }
}

static CHAR *gen_name(id)
    int id;
{
    static CHAR name[16];
    int	 nn;

    if(id<26){
	name[0]='A'+id;
	name[1]=0;
    }else if(id<260){
	nn=id/26;
	id-=nn*26;
	name[0]='A'+id;
	name[1]='0'+nn;
	name[2]=0;
    }else{
	nn=id/26;
	id-=nn*26;
	sprintf(name, "%c%d", 'A'+id, nn);
    }
    return(name);
}

CELL *lookup_var(name)
    CHAR *name;
{
    int	 num;
    register int  i;
    register struct var_number_backet *backet;

    if(var_mode){   /*** Address Mode ***/
	if(sscanf(name, "%d", &num)==0) return(NULL);
	for(i=0; i<TABLE_SIZE; i++){
	    for(backet=var_number_table[i]; backet; backet=backet->next){
		if(backet->rel_addr==num){
		    return(backet->ref);
		}
	    }
	}
    }else{	  /*** Temporary Name Mode ***/
	num=get_var_number(name);
	for(i=0; i<TABLE_SIZE; i++){
	    for(backet=var_number_table[i]; backet; backet=backet->next){
		if(backet->var_number==num){
		    return(backet->ref);
		}
	    }
	}
    }
    return(NULL);  /** Not Found **/
}

static int get_var_number(name)
    CHAR *name;
{
    int	 nn, n2;

    if(*name>='A' && *name<='Z'){
	n2=(*name++)-'A';
	nn=0;
	while(*name>='0' && *name<='9'){
	    nn=nn*10+(*name++)-'0';
	}
	if(*name == 0) return(nn*26+n2);
    }
    return(-1);
}
