/* xlprint - xlisp print routine */ #ifdef AZTEC #include "stdio.h" #else #include #endif #include "xlisp.h" /* external variables */ extern struct node *xlstack; /* local variables */ static char buf[STRMAX+1]; /* xlprint - print an xlisp value */ xlprint(fptr,vptr,flag) struct node *fptr,*vptr; int flag; { struct node *nptr,*next,*msg; /* print null as the empty list */ if (vptr == NULL) { putstr(fptr,"nil"); return; } /* check value type */ switch (vptr->n_type) { case SUBR: putatm(fptr,"Subr",vptr); break; case FSUBR: putatm(fptr,"FSubr",vptr); break; case LIST: xlputc(fptr,'('); for (nptr = vptr; nptr != NULL; nptr = next) { xlprint(fptr,nptr->n_listvalue,flag); if ((next = nptr->n_listnext) != NULL) if (next->n_type == LIST) xlputc(fptr,' '); else { putstr(fptr," . "); xlprint(fptr,next,flag); break; } } xlputc(fptr,')'); break; case SYM: putstr(fptr,xlsymname(vptr)); break; case INT: putdec(fptr,vptr->n_int); break; case STR: if (flag) putstring(fptr,vptr->n_str); else putstr(fptr,vptr->n_str); break; case FPTR: putatm(fptr,"File",vptr); break; case OBJ: putatm(fptr,"Object",vptr); break; default: putatm(fptr,"Foo",vptr); break; } } /* xlterpri - terminate the current print line */ xlterpri(fptr) struct node *fptr; { xlputc(fptr,'\n'); } /* putstring - output a string */ LOCAL putstring(fptr,str) struct node *fptr; char *str; { int ch; /* output the initial quote */ xlputc(fptr,'"'); /* output each character in the string */ while (ch = *str++) /* check for a control character */ if (ch < 040 || ch == '\\') { xlputc(fptr,'\\'); switch (ch) { case '\033': xlputc(fptr,'e'); break; case '\n': xlputc(fptr,'n'); break; case '\r': xlputc(fptr,'r'); break; case '\t': xlputc(fptr,'t'); break; case '\\': xlputc(fptr,'\\'); break; default: putoct(fptr,ch); break; } } /* output a normal character */ else xlputc(fptr,ch); /* output the terminating quote */ xlputc(fptr,'"'); } /* putatm - output an atom */ LOCAL putatm(fptr,tag,val) struct node *fptr; char *tag; int val; { sprintf(buf,"<%s: #%x>",tag,val); putstr(fptr,buf); } /* putdec - output a decimal number */ LOCAL putdec(fptr,n) struct node *fptr; int n; { sprintf(buf,"%d",n); putstr(fptr,buf); } /* puthex - output a hexadecimal number */ LOCAL puthex(fptr,n) struct node *fptr; unsigned int n; { sprintf(buf,"%x",n); putstr(fptr,buf); } /* putoct - output an octal byte value */ LOCAL putoct(fptr,n) struct node *fptr; int n; { sprintf(buf,"%03o",n); putstr(fptr,buf); } /* putstr - output a string */ LOCAL putstr(fptr,str) struct node *fptr; char *str; { while (*str) xlputc(fptr,*str++); }