5 static char *
rcsid=
"@(#)$Id$";
30 ckintval(argv[2]),ckintval(argv[3]));
44 else if (isfilestream(s)) {
53 {
if (n==1 || strm==
NIL) strm=Spevalof(
QSTDOUT);
54 if (strm==
T) strm=Spevalof(QTERMIO);
55 if (isiostream(strm)) strm=strm->c.iostream.out;
64 {
if (n<1 || strm==
NIL) strm=Spevalof(
QSTDIN);
65 if (strm==
T) strm=Spevalof(QTERMIO);
66 if (isiostream(strm)) strm=strm->c.iostream.in;
126 register int i,
n,etype;
131 else if (piscons(s)) {
132 if (ccar(s)==
QUOTE && islist(ccdr(s)) && ccdr(ccdr(s))==
NIL) {
143 else if (pissymbol(s))
prsize[
thr_self()]+=strlength(s->c.sym.pname);
144 else if (pisvector(s)) {
145 n=vecsize(s); i=0; etype=elmtypeof(s);
147 case ELM_BIT:
case ELM_CHAR:
case ELM_FOREIGN:
prsize[
thr_self()]+=2+
n;
break;
159 else prsize[
thr_self()]+=strlength(classof(s)->c.cls.name->c.sym.pname)+12;}
168 if (n==2) lim=ckintval(argv[1]);
else lim=256;
179 if (n>=2) eoferrorp=argv[1];
180 if (n>=3) eofvalue=argv[2];
181 if (n==4) recursivep=argv[3];
182 result=
reader(ctx,strm,recursivep);
184 if (eoferrorp==
NIL)
return(eofvalue);
197 delim_char=ckintval(argv[0]);
199 if (n==3) recursivep=argv[2];
202 if (recursivep==
NIL) {
209 #define READLINE_BUF_LENGTH 8192 216 byte *cb = (
byte *) malloc(READLINE_BUF_LENGTH);
217 register int i=0,
ch,buflength=READLINE_BUF_LENGTH;
220 if (n>=2) eoferrorp=argv[1];
221 if (n==3) eofvalue=argv[2];
228 if (eoferrorp==
NIL)
return(eofvalue);
231 if (i >= buflength) {
232 byte *newcb = malloc(buflength+READLINE_BUF_LENGTH);
238 memcpy(newcb, cb, buflength);
239 buflength += READLINE_BUF_LENGTH;
244 if ((i>=1) && cb[i-1]==
'\r') i=i-1;
257 if (n>=2) eoferrorp=argv[1];
258 if (n==3) eofvalue=argv[2];
261 if (eoferrorp==
NIL)
return(eofvalue);
273 ch=ckintval(argv[0]);
285 if (n>=2) eoferrorp=argv[1];
286 if (n==3) eofvalue=argv[2];
289 if (eoferrorp==
NIL)
return(eofvalue);
312 while (islist(bytes)) {
313 writech(strm,ckintval(ccar(bytes)));
315 else writech(strm,ckintval(bytes));
330 while (islist(bytes)) {
331 buf.s=ckintval(ccar(bytes));
335 buf.s=ckintval(bytes);
351 while (islist(bytes)) {
352 buf.i=bigintval(ccar(bytes));
356 buf.i=bigintval(bytes);
367 if (isstring(argv[0])) ch=argv[0]->
c.
str.
chars[0];
368 else ch=ckintval(argv[0]);
370 if (n>=3) nontermp=argv[2];
371 if (n==4) rdtable=argv[3];
372 else rdtable=Spevalof(QREADTABLE);
374 pointer_update(rdtable->c.rdtab.macro->c.vec.v[ch],argv[1]);
376 else if (nontermp==
NIL) rdtable->c.rdtab.syntax->c.str.chars[
ch]=(int)
ch_termmacro;
386 if (n==2) rdtable=argv[1];
387 else rdtable=Spevalof(QREADTABLE);
398 if (isstring(argv[1])) ch=argv[1]->c.str.chars[0];
399 else ch=ckintval(argv[1]);
401 if (n==4) rdtable=argv[3];
402 else rdtable=Spevalof(QREADTABLE);
414 if (isstring(argv[1])) ch=argv[1]->
c.
str.
chars[0];
415 else ch=ckintval(argv[1]);
417 if (n==3) rdtable=argv[2];
418 else rdtable=Spevalof(QREADTABLE);
435 #define nextcch() ((cx>=cmax)?(byte)((eusinteger_t)error(E_FORMATSTRING)):cstr[cx++]) 437 #define nextfarg() ((fargx>=fargc)?(pointer)error(E_MISMATCHARG):fargv[fargx++]) 447 register int i,j,px,
l;
457 extern double fabs();
460 dest=argv[0]; a=argv[1];
463 fargv=argv; fargc=
n; fargx=2;
467 if (dest==
T) dest=Spevalof(
QSTDOUT);
478 px=0; param[0]=0; param[1]=1; param[2]=0;
479 while (isdigit(cch)) {
481 while (isdigit(cch)) {
482 param[px]=param[px]*10+(cch-
'0');
485 if (cch==
',') cch=nextcch();}
486 if (islower(cch)) cch=toupper(cch);
489 param[px++]=ckintval(varg);
491 if (islower(cch)) cch=toupper(cch);}
503 prinx(ctx,nextfarg(),dest);
508 printnum(ctx,a,dest,10,param[0],param[1]);
512 printnum(ctx,a,dest,16,param[0],param[1]);
516 printnum(ctx,a,dest,8,param[0],param[1]);
520 writech(dest,ckintval(a));
break;
524 sprintf(buf,
"%*.*f",param[0],param[1],fval);
529 sprintf(buf,
"%*.*e",param[0],param[1],fval);
536 if (fabs(fval)<0.0001 || fabs(fval)>1.0e+05) {
537 sprintf(buf,
"%*.*e",param[0],param[1],fval); l=strlen(buf);}
539 sprintf(buf,
"%*.*f",param[0],param[1],fval);
541 while (l>2 && buf[l-1]==
'0' && buf[l-2]!=
'.') l--;}
545 for (j=0; j<=param[0]; j++)
writech(dest,
'\n');
562 else { vpop();
return(
NIL);}
572 if (isstring(argv[0])) {
574 for (i=0; i<
n; i++) vpush(argv[i]);
584 ctx->errhandler=argv[0];
static char buf[CHAR_SIZE]
pointer prinx(context *, pointer, pointer)
pointer PRIN1(context *ctx, int n, argv)
pointer PEEKCH(context *ctx, int n, argv)
pointer getoutstream(context *ctx, int n, pointer strm)
void prntsize(pointer s, int lim)
pointer SETDISPMACRO(context *ctx, int n, argv)
pointer openfile(context *, char *, int, int, int)
pointer read_delimited_list(context *, pointer, int, char *)
pointer defunpkg(context *, char *, pointer, pointer(*)(), pointer)
void printnum(context *, pointer, pointer, int, int, int)
pointer PRINC(context *ctx, int n, argv)
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
enum ch_type chartype[256]
void lispio(context *ctx, pointer mod)
pointer TERPRI(context *ctx, int n, argv)
static int prsize[MAXTHREAD]
byte * current_syntax[MAXTHREAD]
pointer OPENFILE(context *ctx, int n, argv)
pointer INSTALL_ERRHANDLER(context *ctx, int n, pointer *argv)
pointer READ_DELIMITED_LIST(context *ctx, int n, argv)
pointer mkstream(context *, pointer, pointer)
void initreader(context *)
pointer GETMACROCH(context *ctx, int n, argv)
pointer CLOSE(context *ctx, int n, argv)
int writestr(pointer, byte *, int)
pointer getinstream(context *ctx, int n, pointer strm)
int written_count[MAXTHREAD]
pointer SETMACROCH(context *ctx, int n, argv)
pointer SIGERROR(context *ctx, int n, pointer *argv)
pointer READCH(context *ctx, int n, argv)
pointer WRTWORD(context *ctx, int n, pointer *argv)
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
pointer GETDISPMACRO(context *ctx, int n, argv)
pointer PRNTSIZE(context *ctx, int n, argv)
pointer WRTBYTE(context *ctx, int n, pointer *argv)
pointer FINOUT(context *ctx, int n, argv)
pointer makestring(char *, int)
pointer READLINE(context *ctx, int n, argv)
pointer UNREADCH(context *ctx, int n, argv)
int writech(pointer, int)
pointer READ(context *ctx, int n, argv)
int unreadch(pointer, int)
pointer XFORMAT(context *ctx, int n, argv)
pointer RESETREADTABLE(context *ctx, int n, pointer *argv)
pointer PRINT(context *ctx, int n, argv)
pointer WRTLONG(context *ctx, int n, pointer *argv)
pointer reader(context *, pointer, pointer)