lispio.c
Go to the documentation of this file.
1 /****************************************************************/
2 /* lisp I/O functions
3 /* Copyright Toshihiro MATSUI, ETL, 1987
4 /****************************************************************/
5 static char *rcsid="@(#)$Id$";
6 
7 #include "eus.h"
8 #include <ctype.h>
9 
10 #if vxworks
11 #undef READ
12 #else
13 #include <fcntl.h>
14 #endif
15 
16 extern int errno;
17 extern enum ch_type chartype[256];
18 extern pointer QREADTABLE,QTERMIO, oblabels;
19 extern byte *current_syntax[MAXTHREAD];
20 extern int written_count[MAXTHREAD];
21 extern pointer read_delimited_list(context*,pointer,int,char *);
22 
23 pointer OPENFILE(ctx,n,argv)
24 register context *ctx;
25 int n;
26 register pointer argv[];
27 { pointer s;
28  extern pointer openfile();
29  s=openfile(ctx,(char*)get_string(argv[0]), ckintval(argv[1]),
30  ckintval(argv[2]),ckintval(argv[3]));
31  if (s==0) return(makeint(errno));
32  return(s);}
33 
34 pointer CLOSE(ctx,n,argv)
35 register context *ctx;
36 int n;
37 pointer argv[];
38 { register pointer s=argv[0];
39  if (n!=1) error(E_MISMATCHARG);
40  if (isiostream(s)) {
41  if (closestream(s->c.iostream.in)<0) return(NIL);
42  if (closestream(s->c.iostream.out)<0) return(NIL);
43  return(T);}
44  else if (isfilestream(s)) {
45  if (closestream(s)<0) return(NIL);
46  return(T);}
47  else error(E_USER,(pointer)"file stream expected");}
48 
49 pointer getoutstream(ctx,n,strm)
50 context *ctx;
51 int n;
52 register pointer strm;
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;
56  if (!isstream(strm)) error(E_STREAM);
57  if (strm->c.stream.direction!=K_OUT) error(E_IODIRECTION);
58  return(strm);}
59 
60 pointer getinstream(ctx,n,strm)
61 context *ctx;
62 int n;
63 register pointer strm;
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;
67  if (!isstream(strm)) error(E_STREAM);
68  if (strm->c.stream.direction!=K_IN) error(E_IODIRECTION);
69  return(strm);}
70 
71 /****************************************************************/
72 
73 pointer PRINT(ctx,n,argv)
74 register context *ctx;
75 int n;
76 pointer argv[];
77 { pointer s;
78  int osf;
79  ckarg2(1,2);
80  osf=ctx->slashflag;
81  ctx->slashflag=0;
82  prinx(ctx,argv[0],s=getoutstream(ctx,n,argv[1])); terpri(s);
83  ctx->slashflag=osf;
84  return(argv[0]);}
85 
86 pointer PRIN1(ctx,n,argv)
87 register context *ctx;
88 int n;
89 pointer argv[];
90 { ckarg2(1,2);
91  int osf;
92  osf=ctx->slashflag;
93  ctx->slashflag=0;
94  prinx(ctx,argv[0],getoutstream(ctx,n,argv[1]));
95  ctx->slashflag=osf;
96  return(argv[0]);}
97 
98 pointer PRINC(ctx,n,argv)
99 register context *ctx;
100 int n;
101 pointer argv[];
102 { int osf;
103  ckarg2(1,2);
104  osf=ctx->slashflag;
105  ctx->slashflag=1;
106  prinx(ctx,argv[0],getoutstream(ctx,n,argv[1]));
107  ctx->slashflag=osf;
108  return(argv[0]);}
109 
110 pointer TERPRI(ctx,n,argv)
111 register context *ctx;
112 int n;
113 pointer argv[];
114 { pointer strm;
115  ckarg2(0,1);
116  strm=getoutstream(ctx,n+1,argv[0]);
117  terpri(strm);
118  return(NIL);}
119 
120 static int prsize[MAXTHREAD];
121 
122 void prntsize(s,lim)
123 register pointer s;
124 int lim;
125 { char buf[16];
126  register int i,n,etype;
127  numunion nu;
128  if (prsize[thr_self()]>=lim) return;
129  else if (isint(s)) { sprintf(buf,"%ld",intval(s)); prsize[thr_self()]+=strlen(buf);}
130  else if (isflt(s)) prsize[thr_self()]+=7;
131  else if (piscons(s)) {
132  if (ccar(s)==QUOTE && islist(ccdr(s)) && ccdr(ccdr(s))==NIL) {
133  prsize[thr_self()]++; prntsize(ccar(ccdr(s)),lim);} /* ???? */
134  else {
135  prsize[thr_self()]+=2;
136  while (islist(s)) {
137  prntsize(ccar(s),lim);
138  if (prsize[thr_self()]>lim) return;
139  s=ccdr(s);
140  if (s!=NIL) prsize[thr_self()]++;}
141  if (s!=NIL) { prntsize(s,lim); prsize[thr_self()]+=2;}}}
142  else if (pisstring(s)) prsize[thr_self()]+=strlength(s);
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);
146  switch(etype) {
147  case ELM_BIT: case ELM_CHAR: case ELM_FOREIGN: prsize[thr_self()]+=2+n; break;
148  case ELM_BYTE: prsize[thr_self()]+=20; break; /*detarame*/
149  case ELM_FLOAT: case ELM_INT: prsize[thr_self()]++;
150  case ELM_POINTER:
151  prsize[thr_self()]+=3;
152  while (i<n) {
153  if (etype==ELM_FLOAT) prntsize(makeflt(s->c.fvec.fv[i]),lim);
154  else if (etype==ELM_INT) prntsize(makeint(s->c.ivec.iv[i]),lim);
155  else prntsize(s->c.vec.v[i],lim);
156  if (prsize[thr_self()]>lim) return;
157  prsize[thr_self()]++; i++;}
158  break;} }
159  else prsize[thr_self()]+=strlength(classof(s)->c.cls.name->c.sym.pname)+12;}
160 
161 pointer PRNTSIZE(ctx,n,argv)
162 register context *ctx;
163 int n;
164 pointer argv[];
165 { int lim;
166  prsize[thr_self()]=0;
167  ckarg2(1,2);
168  if (n==2) lim=ckintval(argv[1]); else lim=256;
169  prntsize(argv[0],lim);
170  return(makeint(prsize[thr_self()]));}
171 
172 pointer READ(ctx,n,argv)
173 register context *ctx;
174 int n;
175 pointer argv[];
176 { pointer strm,eoferrorp=T,eofvalue=NIL,result,recursivep=NIL;
177  ckarg2(0,4);
178  strm=getinstream(ctx,n,argv[0]);
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);
183  if (result==(pointer)EOF)
184  if (eoferrorp==NIL) return(eofvalue);
185  else error(E_EOF);
186  return(result);}
187 
188 pointer READ_DELIMITED_LIST(ctx,n,argv)
189 register context *ctx;
190 int n;
191 pointer argv[];
192 { pointer strm,result,recursivep=NIL;
193  int delim_char;
194  char token[1024];
195 
196  ckarg2(1,3);
197  delim_char=ckintval(argv[0]);
198  strm=getinstream(ctx,n-1,argv[1]);
199  if (n==3) recursivep=argv[2];
200 
201  current_syntax[thr_self()]=Spevalof(QREADTABLE)->c.rdtab.syntax->c.str.chars;
202  if (recursivep==NIL) {
203  pointer_update(oblabels->c.lab.next,NIL);
204  result=read_delimited_list(ctx,strm,delim_char,token);
205  pointer_update(oblabels->c.lab.next,NIL);}
206  else result=read_delimited_list(ctx,strm,delim_char,token); /*preserve #n= scope*/
207  return(result);}
208 
209 #define READLINE_BUF_LENGTH 8192
210 pointer READLINE(ctx,n,argv)
211 register context *ctx;
212 int n;
213 pointer argv[];
214 { register pointer strm;
215  pointer eoferrorp=T,eofvalue=NIL,ret=NIL;
216  byte *cb = (byte *) malloc(READLINE_BUF_LENGTH);
217  register int i=0,ch,buflength=READLINE_BUF_LENGTH;
218  ckarg2(0,3);
219  strm=getinstream(ctx,n,argv[0]);
220  if (n>=2) eoferrorp=argv[1];
221  if (n==3) eofvalue=argv[2];
222  while (1) {
223  ch=readch(strm);
224  if (ch=='\n') break;
225  else if (ch==EOF) {
226  if (i>0) break;
227  free(cb);
228  if (eoferrorp==NIL) return(eofvalue);
229  else error(E_EOF);}
230  cb[i++]=ch;
231  if (i >= buflength) {
232  byte *newcb = malloc(buflength+READLINE_BUF_LENGTH);
233  if (newcb == NULL) {
234  free(cb);
235  error(E_USER, (pointer)"Memory allocation error by read-line");
236  break;
237  }
238  memcpy(newcb, cb, buflength);
239  buflength += READLINE_BUF_LENGTH;
240  free(cb);
241  cb = newcb;
242  }
243  }
244  if ((i>=1) && cb[i-1]=='\r') i=i-1;
245  ret = makestring((char *)cb,i);
246  free(cb);
247  return(ret);}
248 
249 pointer READCH(ctx,n,argv)
250 register context *ctx;
251 register int n;
252 register pointer argv[];
253 { pointer strm,eoferrorp=T,eofvalue=NIL;
254  register eusinteger_t result;
255  ckarg2(0,3);
256  strm=getinstream(ctx,n,argv[0]);
257  if (n>=2) eoferrorp=argv[1];
258  if (n==3) eofvalue=argv[2];
259  result=readch(strm);
260  if (result==EOF)
261  if (eoferrorp==NIL) return(eofvalue);
262  else error(E_EOF);
263  return(makeint(result));}
264 
265 pointer UNREADCH(ctx,n,argv)
266 register context *ctx;
267 int n;
268 register pointer argv[];
269 { pointer strm;
270  byte ch;
271  ckarg2(1,2);
272  strm=getinstream(ctx,n-1,argv[1]);
273  ch=ckintval(argv[0]);
274  unreadch(strm,ch);
275  return(argv[0]);}
276 
277 pointer PEEKCH(ctx,n,argv)
278 register context *ctx;
279 int n;
280 pointer argv[];
281 { pointer strm,eoferrorp=T,eofvalue=NIL;
282  eusinteger_t result;
283  ckarg2(0,3);
284  strm=getinstream(ctx,n,argv[0]);
285  if (n>=2) eoferrorp=argv[1];
286  if (n==3) eofvalue=argv[2];
287  result=readch(strm);
288  if (result==EOF)
289  if (eoferrorp==NIL) return(eofvalue);
290  else error(E_EOF);
291  unreadch(strm,result);
292  return(makeint(result));}
293 
294 pointer FINOUT(ctx,n,argv) /*finish-output*/
295 register context *ctx;
296 int n;
297 pointer argv[];
298 { pointer strm;
299  strm=getoutstream(ctx,n+1,argv[0]);
300  flushstream(strm);
301  return(NIL);}
302 
303 pointer WRTBYTE(ctx,n,argv)
304 register context *ctx;
305 int n;
306 pointer *argv;
307 { register pointer bytes,strm;
308  ckarg(2);
309  strm=getoutstream(ctx,n,argv[1]);
310  bytes=argv[0];
311  if (islist(bytes))
312  while (islist(bytes)) {
313  writech(strm,ckintval(ccar(bytes)));
314  bytes=ccdr(bytes);}
315  else writech(strm,ckintval(bytes));
316  return(argv[0]);}
317 
318 pointer WRTWORD(ctx,n,argv)
319 register context *ctx;
320 int n;
321 pointer *argv;
322 { register pointer bytes,strm;
323  union {
324  short s;
325  char b[2];} buf;
326  ckarg(2);
327  strm=getoutstream(ctx,n,argv[1]);
328  bytes=argv[0];
329  if (islist(bytes))
330  while (islist(bytes)) {
331  buf.s=ckintval(ccar(bytes));
332  writestr(strm,(byte *)buf.b,2);
333  bytes=ccdr(bytes);}
334  else {
335  buf.s=ckintval(bytes);
336  writestr(strm,(byte *)buf.b,2);}
337  return(argv[0]);}
338 
339 pointer WRTLONG(ctx,n,argv)
340 register context *ctx;
341 int n;
342 pointer *argv;
343 { register pointer bytes,strm;
344  union {
345  int i;
346  byte b[4];} buf;
347  ckarg(2);
348  strm=getoutstream(ctx,n,argv[1]);
349  bytes=argv[0];
350  if (islist(bytes))
351  while (islist(bytes)) {
352  buf.i=bigintval(ccar(bytes));
353  writestr(strm,buf.b,4);
354  bytes=ccdr(bytes);}
355  else {
356  buf.i=bigintval(bytes);
357  writestr(strm,buf.b,4);}
358  return(argv[0]);}
359 
360 pointer SETMACROCH(ctx,n,argv)
361 register context *ctx;
362 int n;
363 pointer argv[];
364 { int ch;
365  pointer nontermp=NIL,rdtable;
366  ckarg2(2,4);
367  if (isstring(argv[0])) ch=argv[0]->c.str.chars[0];
368  else ch=ckintval(argv[0]);
369  if (ch<0 || 256<ch) error(E_CHARRANGE);
370  if (n>=3) nontermp=argv[2];
371  if (n==4) rdtable=argv[3];
372  else rdtable=Spevalof(QREADTABLE);
373  if (!isreadtable(rdtable)) error(E_USER,(pointer)"readtable expected");
374  pointer_update(rdtable->c.rdtab.macro->c.vec.v[ch],argv[1]);
375  if (argv[1]==NIL) rdtable->c.rdtab.syntax->c.str.chars[ch]=(byte)chartype[ch];
376  else if (nontermp==NIL) rdtable->c.rdtab.syntax->c.str.chars[ch]=(int)ch_termmacro;
377  else rdtable->c.rdtab.syntax->c.str.chars[ch]=(int)ch_nontermacro;
378  return(T);}
379 
380 pointer GETMACROCH(ctx,n,argv)
381 register context *ctx;
382 int n;
383 pointer argv[];
384 { pointer rdtable;
385  ckarg2(1,2);
386  if (n==2) rdtable=argv[1];
387  else rdtable=Spevalof(QREADTABLE);
388  if (!isreadtable(rdtable)) error(E_USER,(pointer)"readtable expected");
389  return(rdtable->c.rdtab.macro->c.vec.v[max(0,min(255,ckintval(argv[0])))]);}
390 
391 pointer SETDISPMACRO(ctx,n,argv)
392 register context *ctx;
393 int n;
394 register pointer argv[];
395 { int ch;
396  pointer rdtable,func;
397  ckarg2(3,4);
398  if (isstring(argv[1])) ch=argv[1]->c.str.chars[0];
399  else ch=ckintval(argv[1]);
400  if (ch<0 || 256<ch) error(E_CHARRANGE);
401  if (n==4) rdtable=argv[3];
402  else rdtable=Spevalof(QREADTABLE);
403  if (!isreadtable(rdtable)) error(E_USER,(pointer)"readtable expected");
404  pointer_update(rdtable->c.rdtab.dispatch->c.vec.v[ch],/*(pointer (*)())*/argv[2]);
405  return(T);}
406 
407 pointer GETDISPMACRO(ctx,n,argv)
408 register context *ctx;
409 int n;
410 pointer argv[];
411 { int ch;
412  pointer rdtable,func;
413  ckarg2(2,3);
414  if (isstring(argv[1])) ch=argv[1]->c.str.chars[0];
415  else ch=ckintval(argv[1]);
416  if (ch<0 || 256<ch) error(E_CHARRANGE);
417  if (n==3) rdtable=argv[2];
418  else rdtable=Spevalof(QREADTABLE);
419  if (!isreadtable(rdtable)) error(E_USER,(pointer)"readtable expected");
420  func=rdtable->c.rdtab.dispatch->c.vec.v[ch];
421  return(func);}
422 
423 pointer RESETREADTABLE(ctx,n,argv)
424 register context *ctx;
425 int n; /* unused argument */
426 pointer *argv; /* unused argument */
427 { initreader(ctx); return(T);} /* ???? */
428 
429 /*****************************************************************/
430 /* FORMAT
431 /* 1986-Nov
432 /* T.Matsui
433 */
434 
435 #define nextcch() ((cx>=cmax)?(byte)((eusinteger_t)error(E_FORMATSTRING)):cstr[cx++])
436 
437 #define nextfarg() ((fargx>=fargc)?(pointer)error(E_MISMATCHARG):fargv[fargx++])
438 
439 /*extern void printnum(context *, pointer, pointer, int, int, int);*/
440 
441 pointer XFORMAT(ctx,n,argv)
442 register context *ctx;
443 int n;
444 pointer argv[];
445 {
446  register pointer dest,a;
447  register int i,j,px,l;
448  int param[10],par;
449  char buf[256];
450  eusfloat_t fval;
451  byte *cstr,cch;
452  int cx,cmax;
453  pointer *fargv, varg;
454  int fargc,fargx;
455  int wcount, osf;
456  numunion nu;
457  extern double fabs();
458 
459  if (n<2) error(E_MISMATCHARG);
460  dest=argv[0]; a=argv[1];
461  if (!isstring(a)) error(E_NOSTRING);
462  cx=0; cstr=a->c.str.chars; cmax=intval(a->c.str.length);
463  fargv=argv; fargc=n; fargx=2;
464 
465  if (dest==NIL) dest=(pointer)mkstream(ctx,K_OUT,makebuffer(64));
466  else {
467  if (dest==T) dest=Spevalof(QSTDOUT);
468  if (isiostream(dest)) dest=dest->c.iostream.out;
469  if (!isstream(dest)) error(E_STREAM);
470  if (dest->c.stream.direction!=K_OUT) error(E_IODIRECTION);}
471  vpush(dest);
472 
473  written_count[thr_self()]=0;
474  while (cx<cmax) {
475  cch=nextcch();
476  if (cch=='~') { /*tilda*/
477  cch=nextcch();
478  px=0; param[0]=0; param[1]=1; param[2]=0;
479  while (isdigit(cch)) {
480  param[px]=0;
481  while (isdigit(cch)) {
482  param[px]=param[px]*10+(cch-'0');
483  cch=nextcch();}
484  px++;
485  if (cch==',') cch=nextcch();}
486  if (islower(cch)) cch=toupper(cch);
487  if (cch=='V') {
488  varg=nextfarg();
489  param[px++]=ckintval(varg);
490  cch=nextcch();
491  if (islower(cch)) cch=toupper(cch);}
492  switch(cch) {
493  case 'A': /*Ascii*/
494  a=nextfarg();
495  osf=ctx->slashflag;
496  ctx->slashflag=1;
497  written_count[thr_self()]=0;
498  prinx(ctx,a,dest);
499  while (param[0]>written_count[thr_self()]) writech(dest,' ');
500  ctx->slashflag=osf;
501  break;
502  case 'S': /*S-expression*/
503  written_count[thr_self()]=0;
504  prinx(ctx,nextfarg(),dest);
505  while (param[0]>written_count[thr_self()]) writech(dest,' ');
506  break;
507  case 'D': /*Decimal*/
508  a=nextfarg();
509  printnum(ctx,a,dest,10,param[0],param[1]);
510  break;
511  case 'X': /*heXadecimal*/
512  a=nextfarg();
513  printnum(ctx,a,dest,16,param[0],param[1]);
514  break;
515  case 'O': /*Octal*/
516  a=nextfarg();
517  printnum(ctx,a,dest,8,param[0],param[1]);
518  break;
519  case 'C': /*Character*/
520  a=nextfarg();
521  writech(dest,ckintval(a)); break;
522  case 'F': /*Fixed-format floating-point*/
523  a=nextfarg();
524  fval=ckfltval(a);
525  sprintf(buf,"%*.*f",param[0],param[1],fval);
526  writestr(dest,(byte *)buf,strlen(buf)); break;
527  case 'E': /*Exponential floating-point*/
528  a=nextfarg();
529  fval=ckfltval(a);
530  sprintf(buf,"%*.*e",param[0],param[1],fval);
531  writestr(dest,(byte *)buf,strlen(buf)); break;
532  case 'G': /*General floating-point*/
533  a=nextfarg();
534  fval=ckfltval(a);
535  if (fval==0.0) writestr(dest,(byte *)"0.0",3);
536  else {
537  if (fabs(fval)<0.0001 || fabs(fval)>1.0e+05) {
538  sprintf(buf,"%*.*e",param[0],param[1],fval); l=strlen(buf);}
539  else {
540  sprintf(buf,"%*.*f",param[0],param[1],fval);
541  l=strlen(buf);
542  while (l>2 && buf[l-1]=='0' && buf[l-2]!='.') l--;}
543  writestr(dest,(byte *)buf,l); }
544  break;
545  case '%': case '&': /*newline*/
546  for (j=0; j<=param[0]; j++) writech(dest,'\n');
547  if (argv[0]!=NIL)
548  if (flushstream(dest)!=0) error(E_USER,(pointer)"cannot flush stream");
549  break;
550  case '~': /*tilda*/
551  writech(dest,'~'); break;
552  case 'T': /*tabulate*/
553  writech(dest,9); break;;
554  default: break;
555  }
556  }
557  else writech(dest,cch);}
558  if (argv[0]==NIL) {
559  a=makestring((char *)dest->c.stream.buffer->c.str.chars,
560  intval(dest->c.stream.count));
561  vpop();
562  return(a);}
563  else { vpop(); return(NIL);}
564  }
565 
566 pointer SIGERROR(ctx,n,argv)
567 register context *ctx;
568 register int n;
569 register pointer *argv;
570 { register int i;
571  pointer msg;
572  pointer *argb=ctx->vsp;
573  if (isstring(argv[0])) {
574  vpush(NIL);
575  for (i=0; i<n; i++) vpush(argv[i]);
576  msg=XFORMAT(ctx,n+1,argb);
577  error(E_USER,(pointer)(msg->c.str.chars),argv[1]);}
578  else error((enum errorcode)(ckintval(argv[0])),argv[1]);}
579 
580 pointer INSTALL_ERRHANDLER(ctx,n,argv)
581 register context *ctx;
582 register int n;
583 register pointer *argv;
584 { ckarg(1);
585  ctx->errhandler=argv[0];
586  return(argv[0]);}
587 
588 
589 void lispio(ctx,mod)
590 register context *ctx;
591 pointer mod;
592 {
593  pointer_update(Spevalof(PACKAGE),syspkg);
594  defun(ctx,"OPENFILE",mod,OPENFILE,NULL);
595  pointer_update(Spevalof(PACKAGE),lisppkg);
596 /* defun(ctx,"OPEN",mod,OPEN,NULL); */
597  defun(ctx,"CLOSE",mod,CLOSE,NULL);
598  defun(ctx,"READ",mod,READ,NULL);
599  defun(ctx,"READ-DELIMITED-LIST",mod,READ_DELIMITED_LIST,NULL);
600  defun(ctx,"READ-LINE",mod,READLINE,NULL);
601  defun(ctx,"READ-CHAR",mod,READCH,NULL);
602  defun(ctx,"UNREAD-CHAR",mod,UNREADCH,NULL);
603  defun(ctx,"PEEK-CHAR",mod,PEEKCH,NULL);
604  defun(ctx,"PRINT",mod,PRINT,NULL);
605  defun(ctx,"PRIN1",mod,PRIN1,NULL);
606  defun(ctx,"PRINC",mod,PRINC,NULL);
607  defun(ctx,"TERPRI",mod,TERPRI,NULL);
608  defun(ctx,"PRINT-SIZE",mod,PRNTSIZE,NULL);
609  defun(ctx,"FINISH-OUTPUT",mod,FINOUT,NULL);
610  defun(ctx,"WRITE-BYTE",mod,WRTBYTE,NULL);
611  defun(ctx,"WRITE-WORD",mod,WRTWORD,NULL);
612  defun(ctx,"WRITE-LONG",mod,WRTLONG,NULL);
613  defun(ctx,"SET-MACRO-CHARACTER",mod,SETMACROCH,NULL);
614  defun(ctx,"GET-MACRO-CHARACTER",mod,GETMACROCH,NULL);
615  defun(ctx,"SET-DISPATCH-MACRO-CHARACTER",mod,SETDISPMACRO,NULL);
616  defun(ctx,"GET-DISPATCH-MACRO-CHARACTER",mod,GETDISPMACRO,NULL);
617  defunpkg(ctx,"RESET-READTABLE",mod,RESETREADTABLE,syspkg);
618  defun(ctx,"FORMAT",mod,XFORMAT,NULL);
619  defun(ctx,"ERROR",mod,SIGERROR,NULL);
620  defun(ctx,"INSTALL-ERROR-HANDLER",mod,INSTALL_ERRHANDLER,NULL);
621  }
622 
writestr
int writestr(pointer, byte *, int)
Definition: eusstream.c:218
current_syntax
byte * current_syntax[MAXTHREAD]
Definition: reader.c:41
lispio
void lispio(context *ctx, pointer mod)
Definition: lispio.c:589
numunion
Definition: eus.h:428
buf
static char buf[CHAR_SIZE]
Definition: helpsub.c:23
NIL
pointer NIL
Definition: eus.c:110
mkstream
pointer mkstream(context *, pointer, pointer)
Definition: makes.c:241
FINOUT
pointer FINOUT(context *ctx, int n, argv)
Definition: lispio.c:294
READLINE
pointer READLINE(context *ctx, int n, argv)
Definition: lispio.c:210
unreadch
int unreadch(pointer, int)
Definition: eusstream.c:138
l
long l
Definition: structsize.c:3
QUOTE
pointer QUOTE
Definition: eus.c:110
defun
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
errorcode
errorcode
Definition: eus.h:919
READ_DELIMITED_LIST
pointer READ_DELIMITED_LIST(context *ctx, int n, argv)
Definition: lispio.c:188
makeint
#define makeint(v)
Definition: sfttest.c:2
context
Definition: eus.h:524
s
short s
Definition: structsize.c:2
readch
int readch(pointer)
Definition: eusstream.c:114
UNREADCH
pointer UNREADCH(context *ctx, int n, argv)
Definition: lispio.c:265
PACKAGE
pointer PACKAGE
Definition: eus.c:110
OPENFILE
pointer OPENFILE(context *ctx, int n, argv)
Definition: lispio.c:23
WRTWORD
pointer WRTWORD(context *ctx, int n, pointer *argv)
Definition: lispio.c:318
written_count
int written_count[MAXTHREAD]
Definition: eusstream.c:24
PEEKCH
pointer PEEKCH(context *ctx, int n, argv)
Definition: lispio.c:277
intval
#define intval(p)
Definition: sfttest.c:1
min
#define min(x, y)
Definition: rmflags.c:17
PRINT
pointer PRINT(context *ctx, int n, argv)
Definition: lispio.c:73
ckfltval
float ckfltval()
T
pointer T
Definition: eus.c:110
pointer
struct cell * pointer
Definition: eus.h:165
E_MISMATCHARG
@ E_MISMATCHARG
Definition: eus.h:942
eus.h
makestring
pointer makestring(char *, int)
Definition: makes.c:147
CLOSE
pointer CLOSE(context *ctx, int n, argv)
Definition: lispio.c:34
SETMACROCH
pointer SETMACROCH(context *ctx, int n, argv)
Definition: lispio.c:360
printnum
void printnum(context *, pointer, pointer, int, int, int)
Definition: printer.c:274
E_NOSTRING
@ E_NOSTRING
Definition: eus.h:957
ch
int ch[MAXTHREAD]
Definition: eusstream.c:23
makebuffer
pointer makebuffer(int)
Definition: makes.c:140
QSTDIN
pointer QSTDIN
Definition: eus.c:119
iostream::out
pointer out
Definition: eus.h:291
XFORMAT
pointer XFORMAT(context *ctx, int n, argv)
Definition: lispio.c:441
string::chars
byte chars[1]
Definition: eus.h:212
eusfloat_t
double eusfloat_t
Definition: eus.h:21
WRTLONG
pointer WRTLONG(context *ctx, int n, pointer *argv)
Definition: lispio.c:339
errno
int errno
cell::c
union cell::cellunion c
E_EOF
@ E_EOF
Definition: eus.h:959
rcsid
static char * rcsid
Definition: lispio.c:5
initreader
void initreader(context *)
Definition: reader.c:1034
reader
pointer reader(context *, pointer, pointer)
Definition: reader.c:1016
flushstream
int flushstream(pointer)
Definition: eusstream.c:159
prntsize
void prntsize(pointer s, int lim)
Definition: lispio.c:122
cell::cellunion::rdtab
struct readtable rdtab
Definition: eus.h:420
cell::cellunion::lab
struct labref lab
Definition: eus.h:412
QREADTABLE
pointer QREADTABLE
Definition: eus.c:172
E_IODIRECTION
@ E_IODIRECTION
Definition: eus.h:955
labref::next
pointer next
Definition: eus.h:297
NULL
#define NULL
Definition: transargv.c:8
defunpkg
pointer defunpkg(context *, char *, pointer, pointer(*)(), pointer)
Definition: makes.c:636
PRNTSIZE
pointer PRNTSIZE(context *ctx, int n, argv)
Definition: lispio.c:161
RESETREADTABLE
pointer RESETREADTABLE(context *ctx, int n, pointer *argv)
Definition: lispio.c:423
stream::count
pointer count
Definition: eus.h:277
prsize
static int prsize[MAXTHREAD]
Definition: lispio.c:120
vector::v
pointer v[1]
Definition: eus.h:301
INSTALL_ERRHANDLER
pointer INSTALL_ERRHANDLER(context *ctx, int n, pointer *argv)
Definition: lispio.c:580
syspkg
pointer syspkg
Definition: eus.c:109
E_STREAM
@ E_STREAM
Definition: eus.h:954
get_string
byte * get_string()
prinx
pointer prinx(context *, pointer, pointer)
Definition: printer.c:611
byte
unsigned char byte
Definition: eus.h:163
K_IN
pointer K_IN
Definition: eus.c:130
PRIN1
pointer PRIN1(context *ctx, int n, argv)
Definition: lispio.c:86
ch_nontermacro
@ ch_nontermacro
Definition: eus.h:465
readtable::dispatch
pointer dispatch
Definition: eus.h:350
cell::cellunion::stream
struct stream stream
Definition: eus.h:405
getinstream
pointer getinstream(context *ctx, int n, pointer strm)
Definition: lispio.c:60
SETDISPMACRO
pointer SETDISPMACRO(context *ctx, int n, argv)
Definition: lispio.c:391
READ
pointer READ(context *ctx, int n, argv)
Definition: lispio.c:172
PRINC
pointer PRINC(context *ctx, int n, argv)
Definition: lispio.c:98
chartype
enum ch_type chartype[256]
Definition: reader.c:49
lisppkg
pointer lisppkg
Definition: eus.c:109
readtable::macro
pointer macro
Definition: eus.h:349
makeflt
pointer makeflt()
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
getoutstream
pointer getoutstream(context *ctx, int n, pointer strm)
Definition: lispio.c:49
K_OUT
pointer K_OUT
Definition: eus.c:130
TERPRI
pointer TERPRI(context *ctx, int n, argv)
Definition: lispio.c:110
max
#define max(I1, I2)
Definition: eustags.c:134
E_CHARRANGE
@ E_CHARRANGE
Definition: eus.h:982
openfile
pointer openfile(context *, char *, int, int, int)
Definition: eusstream.c:30
cell
Definition: eus.h:381
eusinteger_t
long eusinteger_t
Definition: eus.h:19
iostream::in
pointer in
Definition: eus.h:291
GETDISPMACRO
pointer GETDISPMACRO(context *ctx, int n, argv)
Definition: lispio.c:407
closestream
int closestream(pointer)
Definition: eusstream.c:53
stream::direction
pointer direction
Definition: eus.h:275
QTERMIO
pointer QTERMIO
Definition: lispio.c:18
read_delimited_list
pointer read_delimited_list(context *, pointer, int, char *)
stream::buffer
pointer buffer
Definition: eus.h:276
oblabels
pointer oblabels
Definition: lispio.c:18
GETMACROCH
pointer GETMACROCH(context *ctx, int n, argv)
Definition: lispio.c:380
writech
int writech(pointer, int)
cell::cellunion::iostream
struct iostream iostream
Definition: eus.h:407
READCH
pointer READCH(context *ctx, int n, argv)
Definition: lispio.c:249
terpri
void terpri(pointer)
Definition: printer.c:637
E_USER
@ E_USER
Definition: eus.h:1006
cell::cellunion::vec
struct vector vec
Definition: eus.h:414
a
char a[26]
Definition: freq.c:4
n
GLfloat n[6][3]
Definition: cube.c:15
WRTBYTE
pointer WRTBYTE(context *ctx, int n, pointer *argv)
Definition: lispio.c:303
SIGERROR
pointer SIGERROR(context *ctx, int n, pointer *argv)
Definition: lispio.c:566
ckarg
ckarg(2)
cell::cellunion::str
struct string str
Definition: eus.h:402
fargv
static float * fargv
Definition: transargv.c:57
thr_self
unsigned int thr_self()
Definition: eus.c:25
QSTDOUT
pointer QSTDOUT
Definition: eus.c:119
ch_type
ch_type
Definition: eus.h:456
ch_termmacro
@ ch_termmacro
Definition: eus.h:464

euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43