#include "lisp.h"
#include "net.h"

/* print routines for netlisp */

/* sun4: modified */
/* #define MAXCOL 70 */	/* maximum column we can use */
#define MAXCOL 1024	/* maximum column we can use */
#define check_col(n)	if (pfile==stdout && cur_col+(n)>MAXCOL) p_char(012)

/* sun4: added */
#define MAXTEMP	1024	/* p_obj character buffer */

#ifndef vax
#define FLOFORMAT "%e"
#endif

#ifdef vax
#define FLOFORMAT "%g"
#endif

int cur_col = 0;	/* current output column */
FILE *pfile;		/* current output file */
symbol *base = NULL;	/* symbol that tells current base */

/* output object to specified file, flag is interpreted as follows:
 *  0	slashification and terminal newline (print)
 *  1	slashification (prin1)
 *  2	(princ)
 */
obj_print(obj,ofile,flag)
  object obj;
  FILE *ofile;
  int flag;
  {	pfile = ofile;	/* use given output file */
	if (base == NULL) {
	  object temp;
	  temp = intern("base");
	  base = (symbol *)ADDR(temp);
	}
	p_obj(obj,flag);
	if (flag == 0) p_char('\n');
}

/* return format string for printing out FIXNUMs */
char *basefmt()
 {	if (ISFIX(base->sym_value)) switch (VALUE(base->sym_value)) {
	  case 16:	return("0x%x");
	  case 8:	return("0%o");
	  default:
	  case 10:	return("%d");
	} else return("%d");
}

/* internal print routine, flag <> 0 indicates "princ" processing */
p_obj(obj,flag)
  object obj;
  int flag;
  {	register int tobj = TYPE(obj);
	register objptr vobj = (objptr)ADDR(obj);
	register char *p;
	register tptr t;
	/* sun4: modified
	 * char temp[100];
	 */
	char temp[MAXTEMP];
	int index;
	extern char *pnode(),*ttype[];

	switch (tobj) {

	  default:	sprintf(temp,"#%d:0%o",tobj,vobj);
			break;

	  case NODE:	sprintf(temp,"<node %s=%c>",
				pnode((nptr)vobj),"0XX1"[((nptr)vobj)->npot]);
			break;

	  case TRANS:	t = (tptr)vobj;
			sprintf(temp,"<%s trans ",ttype[BASETYPE(t)]);
			index = strlen(temp);
			if (t->ttype & GATELIST) {
			  register nptr *p = (nptr *)(t->gate);
			  for (tobj = '('; *p != NULL; tobj = ' ', p += 1) {
			    index = strlen(temp);
			    sprintf(&temp[index],"%c%s=%c",tobj,pnode(*p),
				    "0XX1"[(*p)->npot]);
			  }
			  index = strlen(temp);
			  sprintf(&temp[index],") ");
			} else sprintf(&temp[index],"%s=%c ",pnode(t->gate),
					"0XX1"[t->gate->npot]);
			index = strlen(temp);
			sprintf(&temp[index],"%s=%c ",pnode(t->source),
				 "0XX1"[t->source->npot]);
			index = strlen(temp);
			sprintf(&temp[index],"%s=%c>",pnode(t->drain),
				 "0XX1"[t->drain->npot]);
			break;

	  case FIXNUM:	tobj = SVALUE(obj);
			sprintf(temp,basefmt(),tobj);
			break;

	  case FLONUM:	sprintf(temp,FLOFORMAT,((flonum *)vobj)->flo_value);
			break;

	  case STRING:	sprintf(temp,(flag==2)?"%s":"\"%s\"",vobj);
			break;

	  case SUBR:	sprintf(temp,"#S%o",vobj);
			break;

	  case SYMBOL:	vobj = (objptr)ADDR(((symbol *)vobj)->sym_pname);
			sprintf(temp,"%s",vobj);
			break;

	  case CONS:	if (obj==nil) { sprintf(temp,"nil"); break; }
			check_col(1); p_char('(');
			p_cons(vobj,flag);
			check_col(1); p_char(')');
			temp[0] = 0;
			break;
	}
	check_col(strlen(temp));
	for (p=temp; *p; p_char(*p++));
}

/* recursive ditty for printing cons cells */
p_cons(p,flag)
  register cons *p;
  int flag;
  {	while (1) {
	  p_obj(p->car,flag);
	  if (p->cdr == nil) return;
	  if (ISCONS(p->cdr)) {
	    check_col(1); p_char(' ');
	    p = (cons *)ADDR(p->cdr);
	    continue;
	  }
	  check_col(3); p_char(' '); p_char('.'); p_char(' ');
	  p_obj(p->cdr,flag);
	  return;
	}
}

/* formatted print, perhaps to logfile */
lprintf(f,s,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q)
  FILE *f;
  {	extern FILE *logfile;

	if (logfile!=NULL && (f==stdout || f==stderr))
	  fprintf(logfile,s,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q);
	fprintf(f,s,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q);
}

/* output character to file, keeping track of column */
p_char(ch)
  register char ch;
  {	extern FILE *logfile;

	putc(ch,pfile);
	if (pfile == stdout) switch (ch) {
	  case '\r':
	  case '\n':	cur_col = 0; break;
	  case '\t':	cur_col += 8; cur_col &= ~7; break;
	  case '\b':	cur_col--; break;
	  default:	cur_col++;
	}
	if (logfile!=NULL && (pfile==stdout || pfile==stderr))
	  putc(ch,logfile);
}