reader.c
Go to the documentation of this file.
1 /****************************************************************/
2 /* euslisp reader
3 /* Copyright (c) T.Matsui, Electrotechnical Laboratory
4 /* 1986-
5 /* 1987-Jan dispatch macros
6 /* 1987-May labeled expression #n= and #n#
7 /* 1988-July multiple escape |...|
8 /****************************************************************/
9 static char *rcsid="@(#)$Id$";
10 
11 #include <ctype.h>
12 #include <fcntl.h>
13 #include <signal.h>
14 #include <string.h>
15 #include "eus.h"
16 
17 #if !alpha
18 #define FALSE (0)
19 #define TRUE (1)
20 #endif
21 
22 #define MAXTOKENLENGTH 1024
23 #define MAXSTRINGLENGTH 16384
24 #define to_upper(c) (islower(c) ? ((c)-'a'+'A') : (c))
25 #define to_lower(c) (isupper(c) ? ((c)-'A'+'a') : (c))
26 
27 #define syntaxtype(ch) ((enum ch_type)(current_syntax[thr_self()][ch]))
28 
29 extern pointer FEATURES,READBASE,QREADTABLE;
30 extern pointer QNOT, QAND, QOR; /*eval_read_cond, Jan/1995*/
31 
32 static pointer read1(context *, pointer);
33 static pointer read2(context *, pointer, int, int, int, char*, int);
34 extern pointer makelabref();
35 
36 extern void mul_int_big();
37 extern pointer normalize_bignum();
38 
39 /* the following two global variables are hazardous to multi-threads */
40 /* These should be eliminated in the next release. */
41 byte *current_syntax[MAXTHREAD];
42 pointer oblabels[MAXTHREAD]; /*keep labeled-objects in read*/
43 
44 /****************************************************************/
45 /* character type table
46 /****************************************************************/
47 
48 /*exported*/
49 enum ch_type chartype[256]={
50  ch_illegal, ch_illegal, ch_illegal, ch_illegal, /*0-3*/
51  ch_illegal, ch_illegal, ch_illegal, ch_illegal, /*4-7*/
52  ch_constituent, ch_white, ch_white, ch_illegal, /*8-b*/
53  ch_white, ch_white, ch_illegal, ch_illegal, /*c-f*/
54  ch_illegal, ch_illegal, ch_illegal, ch_illegal, /*10-13*/
55  ch_illegal, ch_illegal, ch_illegal, ch_illegal, /*14-17*/
56  ch_illegal, ch_illegal, ch_illegal, ch_illegal, /*18-1b*/
57  ch_illegal, ch_illegal, ch_illegal, ch_illegal, /*1c-1f*/
58  ch_white, ch_constituent, ch_termmacro, ch_nontermacro, /*20-23*/
59  ch_constituent, ch_constituent, ch_constituent, ch_termmacro, /*24-27*/
60  ch_termmacro, ch_termmacro, ch_constituent, ch_constituent, /*28-2b*/
61  ch_termmacro, ch_constituent, ch_constituent, ch_constituent, /*2c-2f*/
62  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*30-33*/
63  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*34-37*/
64  ch_constituent, ch_constituent, ch_constituent, ch_termmacro, /*38-3b*/
65  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*3c-3f*/
66  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*40-43*/
67  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*44-47*/
68  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*48-4b*/
69  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*4c-4f*/
70  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*50-53*/
71  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*54-57*/
72  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*58-5b*/
73  ch_sglescape, ch_constituent, ch_constituent, ch_constituent, /*5c-5f*/
74  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*60-63*/
75  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*64-67*/
76  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*68-6b*/
77  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*6c-6f*/
78  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*70-73*/
79  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*74-77*/
80  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*78-7b*/
81  ch_multiescape, ch_constituent, ch_constituent, ch_constituent, /*7c-7f*/
82  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*80*/
83  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
84  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
85  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
86  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*90*/
87  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
88  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
89  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
90  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*a0*/
91  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
92  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
93  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
94  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*b0*/
95  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
96  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
97  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
98  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*c0*/
99  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
100  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
101  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
102  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*d0*/
103  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
104  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
105  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
106  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*e0*/
107  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
108  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
109  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
110  ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*f0*/
111  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
112  ch_constituent, ch_constituent, ch_constituent, ch_constituent,
113  ch_constituent, ch_constituent, ch_constituent, ch_constituent};
114 
115 enum ch_attr charattr[256]={
116  illegal, illegal, illegal, illegal, /*0*/
117  illegal, illegal, illegal, illegal,
118  illegal, illegal, illegal, illegal,
119  illegal, illegal, illegal, illegal,
120  illegal, illegal, illegal, illegal, /*10*/
121  illegal, illegal, illegal, illegal,
122  illegal, illegal, illegal, illegal,
123  illegal, illegal, illegal, illegal,
124  alphabetic, alphabetic, alphabetic, alphabetic, /*20*/
125  alphabetic, alphabetic, alphabetic, alphabetic,
126  alphabetic, alphabetic, alphabetic, alphabetic,
127  alphabetic, alphabetic, alphabetic, alphabetic,
128  alphadigit, alphadigit, alphadigit, alphadigit, /*30*/
129  alphadigit, alphadigit, alphadigit, alphadigit,
130  alphadigit, alphadigit, package_marker, alphabetic,
131  alphabetic, alphabetic, alphabetic, alphabetic,
132  alphabetic, alphabetic, alphabetic, alphabetic, /*40*/
133  alphabetic, alphabetic, alphabetic, alphabetic,
134  alphabetic, alphabetic, alphabetic, alphabetic,
135  alphabetic, alphabetic, alphabetic, alphabetic,
136  alphabetic, alphabetic, alphabetic, alphabetic, /*50*/
137  alphabetic, alphabetic, alphabetic, alphabetic,
138  alphabetic, alphabetic, alphabetic, alphabetic,
139  alphabetic, alphabetic, alphabetic, alphabetic,
140  alphabetic, alphabetic, alphabetic, alphabetic, /*60*/
141  alphabetic, alphabetic, alphabetic, alphabetic,
142  alphabetic, alphabetic, alphabetic, alphabetic,
143  alphabetic, alphabetic, alphabetic, alphabetic,
144  alphabetic, alphabetic, alphabetic, alphabetic, /*70*/
145  alphabetic, alphabetic, alphabetic, alphabetic,
146  alphabetic, alphabetic, alphabetic, alphabetic,
147  alphabetic, alphabetic, alphabetic, alphabetic,
148  alphabetic, alphabetic, alphabetic, alphabetic, /*80*/
149  alphabetic, alphabetic, alphabetic, alphabetic,
150  alphabetic, alphabetic, alphabetic, alphabetic,
151  alphabetic, alphabetic, alphabetic, alphabetic,
152  alphabetic, alphabetic, alphabetic, alphabetic, /*90*/
153  alphabetic, alphabetic, alphabetic, alphabetic,
154  alphabetic, alphabetic, alphabetic, alphabetic,
155  alphabetic, alphabetic, alphabetic, alphabetic,
156  alphabetic, alphabetic, alphabetic, alphabetic, /*a0*/
157  alphabetic, alphabetic, alphabetic, alphabetic,
158  alphabetic, alphabetic, alphabetic, alphabetic,
159  alphabetic, alphabetic, alphabetic, alphabetic,
160  alphabetic, alphabetic, alphabetic, alphabetic, /*b0*/
161  alphabetic, alphabetic, alphabetic, alphabetic,
162  alphabetic, alphabetic, alphabetic, alphabetic,
163  alphabetic, alphabetic, alphabetic, alphabetic,
164  alphabetic, alphabetic, alphabetic, alphabetic, /*c0*/
165  alphabetic, alphabetic, alphabetic, alphabetic,
166  alphabetic, alphabetic, alphabetic, alphabetic,
167  alphabetic, alphabetic, alphabetic, alphabetic,
168  alphabetic, alphabetic, alphabetic, alphabetic, /*d0*/
169  alphabetic, alphabetic, alphabetic, alphabetic,
170  alphabetic, alphabetic, alphabetic, alphabetic,
171  alphabetic, alphabetic, alphabetic, alphabetic,
172  alphabetic, alphabetic, alphabetic, alphabetic, /*e0*/
173  alphabetic, alphabetic, alphabetic, alphabetic,
174  alphabetic, alphabetic, alphabetic, alphabetic,
175  alphabetic, alphabetic, alphabetic, alphabetic,
176  alphabetic, alphabetic, alphabetic, alphabetic, /*f0*/
177  alphabetic, alphabetic, alphabetic, alphabetic,
178  alphabetic, alphabetic, alphabetic, alphabetic,
179  alphabetic, alphabetic, alphabetic, alphabetic
180  };
181 
182 /****************************************************************/
183 /* euLisp READER */
184 /****************************************************************/
185 /*
186 /* reader primitives
187 */
188 #if IRIX || Linux_ppc
189 #define Char int
190 #else
191 #if ARM
192 #define Char signed char
193 #else
194 #define Char char
195 #endif
196 #endif
197 
198 static Char skip(ctx, f, ch)
199 context *ctx;
200 register pointer f;
201 Char ch;
202 { skipblank:
203  while (syntaxtype((char)ch)==ch_white) {
204  ch=readch(f);
205  if (ch==EOF) return(EOF);}
206  if (ch == ';' && (Spevalof(QREADTABLE)->c.rdtab.macro->c.vec.v[ch]
207  == charmacro[';'])) {
208  /*syntax type for comment should be checked*/
209  do {
210  ch=readch(f);
211  if (ch==EOF) return(EOF); }
212  while(ch!='\n');
213  goto skipblank;} return(ch); }
214 
215 static int nextch(ctx, f)
216 context *ctx;
217 register pointer f;
218 {
219  Char ch;
220  ch=readch(f); ch=skip(ctx, f,ch); return(ch);}
221 
222 
223 /****************************************************************/
224 /* labeled expression (#n=, #n#)
225 /****************************************************************/
226 
227 static pointer findlabel(labx)
228 eusinteger_t labx;
229 { register pointer obj,labid;
230  labid=makeint(labx);
231  obj=oblabels[thr_self()]->c.lab.next;
232  while (obj!=NIL) {
233  if (obj->c.lab.label==labid) return(obj);
234  else obj=obj->c.lab.next; }
235  return(NIL);}
236 
237 static pointer readlabdef(ctx,f,labx)
238 context *ctx;
239 pointer f; /*stream*/
240 eusinteger_t labx;
241 { pointer unsol, *unsolp, result,newlab;
242 
243  if (findlabel(labx)!=NIL) error(E_READLABEL,makeint(labx)); /*already defined*/
244  newlab=(pointer)makelabref(makeint(labx),UNBOUND,oblabels[thr_self()]->c.lab.next);
245  pointer_update(oblabels[thr_self()]->c.lab.next,newlab);
246  result=read1(ctx,f);
247 
248  /*solve references*/
249  pointer_update(newlab->c.lab.value,result);
250  unsol=newlab->c.lab.unsolved;
251  while (unsol!=NIL) {
252 #if sun3 || (!alpha && system5) || sanyo
253  unsolp=(pointer *)unsol;
254 #endif
255 #if (WORD_SIZE == 64)
256  unsolp=(pointer *)((eusinteger_t)unsol & ~3L);/*???? */
257 #else
258  unsolp=(pointer *)((eusinteger_t)unsol & ~3);/*???? */
259 #endif
260  unsol= *unsolp;
261  pointer_update(*unsolp,result); }
262  return(result);}
263 
264 static void addunsolved(labp,addr)
265 pointer labp;
266 pointer *addr;
267 { pointer_update(*addr,labp->c.lab.unsolved);
268 #if sun3 ||( !alpha && system5 ) || sanyo
269  labp->c.lab.unsolved=(pointer)addr;
270 #endif
271 #if sun4 || vax || news || mips || alpha || Linux
272  { eusinteger_t i;
273  i=(((eusinteger_t)addr)>>2);
274  labp->c.lab.unsolved=makeint(i);}
275 #endif
276 }
277 
278 static pointer readlabref(ctx,f,val,subchar)
279 register context *ctx;
280 pointer f;
281 eusinteger_t val;
282 int subchar;
283 { register pointer obj,element;
284  obj=findlabel(val);
285  if (obj==NIL) error(E_READLABEL,makeint(val)); /*undefined label*/
286  if ((element=obj->c.lab.value)==UNBOUND) return(obj);
287  else return(element);}
288 
289 
290 /****************************************************************/
291 /* read vector and object
292 /* #(, #v(, #f(, #i(, #j(
293 /****************************************************************/
294 static pointer readvector(ctx,f,size)
295 register context *ctx;
296 register pointer f;
297 register int size;
298 { register pointer result,element;
299  register int i=0;
300  Char ch;
301  ch=nextch(ctx,f);
302  if (size>0) {
303  result=makevector(C_VECTOR,size);
304  vpush(result);
305  while ((ch!=')') && (ch!=EOF) && (i<size)) {
306  unreadch(f,ch);
307  element=read1(ctx,f);
308  if (islabref(element)) { /*refer to undefined labeled obj*/
309  addunsolved(element,&result->c.vec.v[i]); }
310  else pointer_update(result->c.vec.v[i],element);
311  i++;
312  ch=nextch(ctx,f);}
313  if (ch==')')
314  while (i<size) {pointer_update(result->c.vec.v[i],element);i++;}
315  else {
316  while (ch!=')' && ch!=EOF) ch=nextch(ctx,f);
317  error(E_READ); }
318  return(result);}
319  else {
320  while ((ch!=')') && (ch!=EOF)) {
321  unreadch(f,ch);
322  element=read1(ctx,f);
323  ckpush(element);
324  i++;
325  ch=nextch(ctx,f);}
326  result=makevector(C_VECTOR,i);
327  while (i>0) {
328  i--;
329  element=vpop();
330  if (islabref(element)) addunsolved(element,&result->c.vec.v[i]);
331  else pointer_update(result->c.vec.v[i],element); }
332  return(result); } }
333 
334 static pointer readivector(ctx,s)
335 register context *ctx;
336 register pointer s;
337 { register int i=0;
338  register eusinteger_t x;
339  register pointer elm;
340  register pointer rvec;
341  Char ch;
342  ch=nextch(ctx,s);
343  if (ch!='(') error(E_READFVECTOR);
344  ch=nextch(ctx,s);
345  while (ch!=')' && ch!=EOF) {
346  unreadch(s,ch);
347  elm=read1(ctx,s);
348  x=ckintval(elm);
349  ch=nextch(ctx,s);
350  vpush(elm);
351  i++;}
352  rvec=makevector(C_INTVECTOR,i);
353  while (i>0) {
354  elm=vpop();
355  x=bigintval(elm);
356  rvec->c.ivec.iv[--i]=x;}
357  return(rvec);}
358 
359 static pointer readfvector(ctx,s)
360 register context *ctx;
361 register pointer s;
362 { register int i=0,x;
363  register pointer elm;
364  eusfloat_t f;
365  Char ch;
366  numunion nu;
367 
368  ch=nextch(ctx,s);
369  if (ch!='(') error(E_READFVECTOR);
370  ch=nextch(ctx,s);
371  while (ch!=')' && ch!=EOF) {
372  unreadch(s,ch);
373  elm=read1(ctx,s);
374  if (!isnum(elm)) error(E_READFVECTOR);
375  if (isint(elm)) { f=intval(elm); elm=makeflt(f);}
376  ckpush(elm);
377  i++;
378  ch=nextch(ctx,s);}
379  elm=makevector(C_FLTVECTOR,i);
380  while (i>0) elm->c.fvec.fv[--i]=fltval(vpop());
381  return(elm);}
382 
383 static pointer readobject(ctx,s)
384 register context *ctx;
385 register pointer s; /*input stream*/
386 {
387  register pointer name, klass, elem, result;
388  register eusinteger_t sz;
389  register int i;
390  Char ch;
391 
392  ch=nextch(ctx,s);
393  if (ch!='(') error(E_READOBJECT);
394  name=read1(ctx,s);
395  if (!issymbol(name)) error(E_READOBJECT);
396  klass=speval(name);
397  if (klass==UNBOUND) error(E_NOCLASS,name);
398  if (!isclass(klass)) error(E_READOBJECT);
399  if (isvecclass(klass)) {
400  elem=read1(ctx,s);
401  if (!isint(elem)) error(E_READOBJECT); /*vector size*/
402  sz=intval(elem);
403  result=makevector(klass,sz);
404  i=1;}
405  else if (isclass(klass)) {
406  result=(pointer)makeobject(klass);
407  i=0;}
408  else error(E_NOCLASS,name);
409  vpush(result);
410  ch=nextch(ctx,s);
411  while (ch!=')' && ch!=EOF) {
412  unreadch(s,ch);
413  elem=read1(ctx,s);
414  if (islabref(elem)) { /*refer to undefined labeled obj*/
415  addunsolved(elem,&result->c.obj.iv[i++]); }
416  else result->c.obj.iv[i++]=elem;
417  ch=nextch(ctx,s);
418  }
419  vpop();
420  return(result); }
421 
422 static pointer readstructure(ctx,s)
423 register context *ctx;
424 register pointer s; /*input stream*/
425 { register pointer name, klass, slot, elem, result, varvec, *slotp;
426  Char ch;
427 
428  ch=nextch(ctx,s);
429  if (ch!='(') error(E_READOBJECT);
430  name=read1(ctx,s);
431  if (!issymbol(name)) error(E_READOBJECT);
432  klass=speval(name);
433  if (klass==UNBOUND) error(E_NOCLASS,name);
434  if (!isclass(klass)) error(E_READOBJECT);
435  if (isvecclass(klass)) { error(E_NOCLASS,name);}
436  else if (isclass(klass)) result=(pointer)makeobject(klass);
437  else error(E_NOCLASS,name);
438  vpush(result);
439  ch=nextch(ctx,s);
440  while (ch!=')' && ch!=EOF) {
441  unreadch(s,ch);
442  slot=read1(ctx,s);
443  if (!issymbol(slot)) error(E_NOSYMBOL);
444  elem=read1(ctx,s);
445  slotp=(pointer *)getobjv(slot,klass->c.cls.vars,result);
446  if (slotp!=NULL) {
447  if (islabref(elem)) { /*refer to undefined labeled obj*/
448  addunsolved(elem,slotp); }
449  else pointer_update(*slotp,elem); }
450  ch=nextch(ctx,s);
451  }
452  vpop();
453  return(result); }
454 
455 /****************************************************************/
456 /* read dispatch macro expression
457 /****************************************************************/
458 static pointer read_sharp_char(ctx,f,val,subchar) /* #\ */
459 register context *ctx;
460 register pointer f;
461 eusinteger_t val;
462 int subchar;
463 { char ch;
464  ch=readch(f); return(makeint(ch));}
465 
466 static pointer read_sharp_comment(ctx,f,val,subchar) /* #| ... |# */
467 register context *ctx;
468 register pointer f;
469 register eusinteger_t val;
470 register int subchar;
471 { Char ch;
472  val=0;
473  ch=readch(f);
474  morecomments:
475  while (ch!=subchar && ch!='#' && ch!=EOF) ch=readch(f);
476  if (ch==EOF) return((pointer)EOF);
477  if (ch==subchar) {
478  ch=readch(f);
479  if (ch=='#') { if (--val<0) return(UNBOUND);}
480  goto morecomments;}
481  ch=readch(f);
482  if (ch==subchar) { ch=readch(f); val++;}
483  goto morecomments;}
484 
485 static pointer read_sharp_hex(ctx,f,val,subchar)
486 register context *ctx;
487 register pointer f;
488 eusinteger_t val;
489 int subchar;
490 { register int i=0,j,c,p,q;
491  pointer b;
492  eusinteger_t *bv,x;
493  char ch, buf[WORD_SIZE];
494 
495  ch=readch(f);
496  while (i<WORD_SIZE && isxdigit(ch)) { buf[i++] = ch; ch=readch(f);}
497  unreadch(f,ch); buf[i]=0;
498  j = i*4 - (buf[0]<'2' ? 3 :
499  buf[0]<'4' ? 2 :
500  buf[0]<'8' ? 1 : 0); /* alphabet is bigger than '9'*/
501  if (j<WORD_SIZE-2) { sscanf(buf,"%lx",&val); return(makeint(val));}
502  else {
503  b= (pointer)makebig((j+WORD_SIZE-2)/(WORD_SIZE-1));
504  bv=bigvec(b);
505  p=0;q=0;
506  for (j=i-1; j>=0; j--) {
507  c=toupper(buf[j]);
508  x=(c<='9')?(c-'0'):(c-'A'+10);
509  bv[p/(WORD_SIZE-1)] |= ((x << q) & MASK);
510  if (q>=(WORD_SIZE-4) && (x>>(WORD_SIZE-1-q)))
511  bv[p/(WORD_SIZE-1) + 1] = x>>(WORD_SIZE-1-q);
512  p +=4; q = (q+4) % (WORD_SIZE-1);
513  }
514  b=(pointer)normalize_bignum(b);
515  return(b);}
516  }
517 
518 static pointer read_sharp_octal(ctx,f,val,subchar)
519 register context *ctx;
520 pointer f;
521 eusinteger_t val;
522 int subchar;
523 { register int i=0;
524  char buf[WORD_SIZE/2], ch;
525  ch=readch(f); val=0;
526  while (i<WORD_SIZE/2 && ch>='0' && ch<'8') { buf[i++] = ch; ch=readch(f);}
527  unreadch(f,ch); buf[i]=0;
528  sscanf(buf,"%lo",&val);
529  return(makeint(val));}
530 
531 static pointer read_sharp_function(ctx,f,val,subchar) /* #' */
532 register context *ctx;
533 pointer f;
534 eusinteger_t val;
535 int subchar;
536 { return(cons(ctx,FUNCTION,cons(ctx,read1(ctx,f),NIL)));}
537 
538 static pointer read_uninterned_symbol(ctx,f,val,subchar,token) /* #: */
539 context *ctx;
540 pointer f;
541 eusinteger_t val;
542 int subchar;
543 char token[];
544 { register int i=0;
545  char ch;
546  ch=readch(f);
547  while (syntaxtype(ch)==ch_constituent) {
548  token[i++]=to_upper(ch); ch=readch(f);}
549  token[i]=0; unreadch(f,ch);
550  return(makesymbol(ctx,(char *)token,i,NIL));}
551 
552 static pointer read_sharp_eval(ctx,f)
553 register context *ctx;
554 pointer f;
555 { pointer p;
556  p=read1(ctx,f);
557 /* if (debug) prinx(ctx,p,Spevalof(QSTDOUT)); */
558  return(eval(ctx,p));}
559 
560 static pointer eval_read_cond(ctx,expr)
561 context *ctx;
562 pointer expr;
563 { pointer r;
564  if (issymbol(expr)) return(memq(expr,speval(FEATURES)));
565  if (iscons(expr)) {
566  if (ccar(expr)==QNOT) {
567  r=eval_read_cond(ctx,ccar(ccdr(expr)));
568  return((r==NIL)?T:NIL);}
569  else if (ccar(expr)==QAND) {
570  expr=ccdr(expr);
571  while (iscons(expr)) {
572  r=eval_read_cond(ctx,ccar(expr));
573  if (r==NIL) return(NIL);
574  else expr=ccdr(expr);}
575  return(T);}
576  else if (ccar(expr)==QOR) {
577  expr=ccdr(expr);
578  while (iscons(expr)) {
579  r=eval_read_cond(ctx,ccar(expr));
580  if (r!=NIL) return(T);
581  else expr=ccdr(expr);}
582  return(NIL);}}
583  error(E_USER,(pointer)"AND/OR/NOT expected in #+ or #-", expr);}
584 
585 static pointer read_cond_plus(ctx,f) /* #+ */
586 register context *ctx;
587 register pointer f;
588 { register pointer flag,result;
589  flag=read1(ctx,f);
590  vpush(flag);
591  result=read1(ctx,f);
592  if (eval_read_cond(ctx,flag)==NIL) result=(pointer)UNBOUND;
593  vpop();
594  return(result);}
595 
596 static pointer read_cond_minus(ctx,f) /* #- */
597 register context *ctx;
598 register pointer f;
599 { register pointer flag,result;
600  flag=read1(ctx,f);
601  vpush(flag);
602  result=read1(ctx,f);
603  if (eval_read_cond(ctx,flag)!=NIL) result=(pointer)UNBOUND;
604  vpop();
605  return(result);}
606 
607 static pointer read_sharp_object(ctx,f) /* #< */
608 register context *ctx;
609 register pointer f;
610 { register pointer element,result,obj;
611  register eusinteger_t val;
612  Char ch;
613  element=read1(ctx,f);
614  if (!issymbol(element)) error(E_NOSYMBOL); /*class name*/
615  element=speval(element);
616  if (element==UNBOUND || !isclass(element)) error(E_NOCLASS,element);
617  obj=read1(ctx,f); val=ckintval(obj);
618  result=makepointer(val);
619  if (classof(result)!=element)
620  error(E_TYPEMISMATCH, (pointer)"read #<> class mismatch"); /* ???? */
621  ch=readch(f);
622  while (ch!='>' && ch!=EOF) ch=readch(f);
623  return(result);}
624 
625 static pointer readsharp(ctx,f,ch,token)
626 register context *ctx;
627 register pointer f;
628 Char ch;
629 char token[];
630 { register eusinteger_t val=0;
631  register int i=0,subchar;
632  pointer macrofunc,result;
633  pointer (*intmac)();
634 
635  ch=readch(f);
636  if (ch==EOF) return(UNBOUND);
637  while (isdigit(ch)) {
638  val=val*10+ch-'0'; ch=nextch(ctx,f);
639  if (ch==EOF) return(UNBOUND);}
640  subchar=to_upper(ch);
641  macrofunc=Spevalof(QREADTABLE)->c.rdtab.dispatch->c.vec.v[subchar];
642  if (macrofunc==NIL) error(E_USER,(pointer)"no # macro defined");
643  if (isint(macrofunc)) { /*internal macro*/
644  intmac=(pointer (*)())(intval(macrofunc));
645  result=(*intmac)(ctx,f,val,subchar,token);}
646  else {
647  vpush(f); vpush(makeint(subchar)); vpush(makeint(val));
648  result=ufuncall(ctx,macrofunc,macrofunc,(pointer)(ctx->vsp-3),NULL,3);
649  ctx->vsp-=3;}
650  return(result);}
651 
652 static pointer readstring(ctx,f,terminator)
653 register context *ctx;
654 pointer f;
655 int terminator;
656 { int tleng = 0, lengmax=MAXSTRINGLENGTH; /* '"' is ignored */
657  byte buf[MAXSTRINGLENGTH], *token, *newtoken;
658  int ch, malloced=FALSE;
659  pointer p;
660 
661  ch=readch(f);
662  token=buf;
663  while ((ch!=terminator) && (ch!=EOF)) {
664  if (syntaxtype(ch) == ch_sglescape) ch=readch(f); /*read escaped char*/
665  token[tleng++]=ch;
666  if (tleng >= lengmax) { /*allocate bigger string buffer*/
667  /*and copy the accumulated characters so far*/
668  newtoken=(byte *)malloc(lengmax*2);
669  memcpy(newtoken,token,tleng);
670  if (malloced==TRUE) cfree(token);
671  malloced=TRUE;
672  token=newtoken; lengmax=lengmax*2;
673  }
674  ch=readch(f);}
675  token[tleng] = '\0';
676  p=makestring((char *)token,tleng);
677  if (malloced==TRUE) cfree(token);
678  return(p);
679  }
680 
681 static pointer readsymbol(ctx,leng,colon, token)
682 register context *ctx;
683 register int leng,colon;
684 char token[];
685 { register pointer pkg;
686  pointer pkgstr,sym;
687  register int doublecolon=1;
688  int hash;
689  if (colon==0) pkg=keywordpkg;
690  else if (colon>0) {
691  if (charattr[token[colon-1]]==package_marker) {
692  pkg=(pointer)searchpkg((byte *)token,colon-1);}
693  else {
694  doublecolon=0;
695  pkg=(pointer)searchpkg((byte *)token,colon);}
696  if (pkg==(pointer)NULL) {
697  if (doublecolon) colon--;
698  pkgstr=makestring(token,colon);
699  vpush(pkgstr);
700  error(E_NOPACKAGE,pkgstr);} }
701  else pkg=Spevalof(PACKAGE); /*use current package for symbol search*/
702  colon++; /*colon-th character starts symbol name string*/
703  if (doublecolon) return(intern(ctx,&token[colon],leng-colon,pkg));
704  else {
705  sym=findsymbol((byte *)&token[colon],leng-colon, pkg->c.pkg.symvector, &hash);
706 /* sym=findsymbol((char *)&token[colon],leng-colon, pkg->c.pkg.symvector, &hash);*/
707  if (sym) return(sym);
708  else {
709  pkgstr=makestring(token,leng);
710  fprintf(stderr,"%s ",token);
711  vpush(pkgstr);
712  error(E_EXTSYMBOL,pkgstr);}
713  } }
714 
715 /* news does not have strtol routine! */
716 #if news || sanyo
717 int strtol(str,ptr,base)
718 register char *str,**ptr;
719 register int base;
720 { long val=0,sign=1;
721  char ch;
722  while (isspace(*str)) str++;
723  ch= *str;
724  if (ch=='+') str++; else if (ch=='-') { str++; sign= -1;}
725  if (base<=10) {
726  while ('0'<= *str && *str<('0'+base)) val=val*base+(*str++)-'0';
727  return(sign*val);}
728  else {
729  while (1) {
730  if ('0'<= *str && *str<='9') val=val*base+(*str++ -'0');
731  else if ('A'<= *str && *str<('A'+base-10)) val=val*base+(*str++ - 'A'+10);
732  else if ('a'<= *str && *str<('a'+base-10)) val=val*base+(*str++ - 'a'+10);
733  else break;
734  continue;}
735  return(sign*val);}}
736 #endif
737 
738 static pointer readint(ctx,token,len)
739 context *ctx;
740 char *token;
741 int len;
742 { eusinteger_t base=intval(Spevalof(READBASE));
743  int head,i,sign=1, k;
744  pointer b;
745 
746  if (len<8) {
747  i=strtol(token,NULL,base);
748  return(makeint(i));}
749  else {
750  if (token[0]=='+') { head=1;}
751  else if (token[0]=='-') {head=1; sign= -1;}
752  else head=0;
753  b=(pointer)makebig1(0);
754  vpush(b);
755  for (i=head; i<len; i++) {
756  k= (int) token[i];
757  if (k>='0' && k<='9') k= k-'0';
758  else if (k>='A' && k<='Z') k=k-'A'+10;
759  else if (k>='a' && k<='z') k=k-'a'+10;
760  else if (k=='.') continue;
761  else error(E_USER,(pointer)"illegal integer consituent char");
762  mul_int_big(base,b);
763  add_int_big(k,b); }
764  if (sign<0) complement_big(b);
765  b=(pointer)normalize_bignum(b);
766  }
767  ctx->lastalloc= vpop();
768  return(b);}
769 
770 int is_digit(ch,base)
771 register int ch,base;
772 { if (ch<'0') return(FALSE);
773  if (base<=10)
774  if (ch<'0'+base) return(TRUE);
775  else return(FALSE);
776  else if (ch<='9') return(TRUE);
777  else if ('A'<=ch && ch<'A'+base-10) return(TRUE);
778  else return(FALSE);}
779 
780 pointer read_delimited_list(ctx,f,delim_char,token)
781 register context *ctx;
782 pointer f;
783 int delim_char;
784 char token[];
785 { pointer result=NIL;
786  pointer temp,element;
787  Char ch;
788  ch=nextch(ctx,f);
789  vpush(STOPPER); /*marker*/
790  while (ch!=delim_char && ch!=EOF) {
791  if (ch=='.') {
792  ch=readch(f); unreadch(f,ch);
793  if (syntaxtype(ch)==ch_constituent) {
794  token[0]='.';
795  element=read2(ctx,f,0,0,1,token, -1);}
796  else if (syntaxtype(ch)==ch_white) {
797  result=read1(ctx,f);
798  ch=nextch(ctx,f);
799  if (ch!=delim_char) error(E_READ);
800  break;}
801  else error(E_READ);}
802  else { unreadch(f,ch); element=read1(ctx,f);}
803  if (element!=UNBOUND && element!=(pointer)EOF) ckpush(element);
804  ch=nextch(ctx,f);}
805  while ((element=vpop())!=STOPPER) {
806  temp=cons(ctx,element,result);
807  if (islabref(element)) addunsolved(element,&temp->c.cons.car);
808  if (islabref(result)) addunsolved(result,&temp->c.cons.cdr);
809  result=temp;}
810  return(result); }
811 
812 static pointer readlist(ctx,f,ch,token)
813 register context *ctx;
814 pointer f;
815 char ch, token[];
816 { return(read_delimited_list(ctx,f,')',token));}
817 
818 static pointer readquote(ctx,f)
819 register context *ctx;
820 pointer f;
821 { pointer q;
822  q=read1(ctx,f);
823  if (q==(pointer)EOF) return((pointer)EOF);
824  return(cons(ctx,QUOTE,cons(ctx,q,NIL)));}
825 
826 static pointer readcomment(ctx,f)
827 register context *ctx;
828 pointer f;
829 { register Char ch;
830  do { ch=readch(f);} while (ch!='\n' && ch!=EOF);
831  return(UNBOUND);}
832 
833 static pointer readrparen(ctx,f)
834 register context *ctx;
835 pointer f;
836 { return(UNBOUND);}
837 
838 
839 
840 int gcd(u,v)
841 register int u,v;
842 { register int t;
843  if(u<0) u = -u;
844  if(v<0) v = -v;
845  if(u<v) {t=u; u=v; v=t;}
846  while(v!=0){t=u % v; u=v; v=t;}
847  return(u);}
848 
849 static pointer readratio(ctx,token,slash)
850 context *ctx;
851 char *token;
852 int slash;
853 { int num, denom, g;
854  extern pointer makeratio();
855  num=strtol(token,NULL,intval(Spevalof(READBASE)));
856  denom=strtol(&token[slash+1],NULL,intval(Spevalof(READBASE)));
857  g=gcd(num, denom);
858  if (g!=0) { num /= g; denom /= g;}
859  else return(makeint(0));
860  if (denom==1) return(makeint(num));
861  return(makeratio(num, denom));}
862 
863 
864 static pointer read2(ctx,ins,escaped,multiescaped,i,token,colon)
865 register context *ctx;
866 register pointer ins;
867 int escaped,multiescaped,i;
868 char token[];
869 int colon;
870 { register int j,c;
871  register eusinteger_t base;
872  int slash;
873  enum ch_type ctype;
874  /*Char ch;*/
875  int ch;
876  pointer readcase;
877  numunion nu;
878  extern double atof();
879 
880  readcase=Spevalof(QREADTABLE)->c.rdtab.readcase;
881 
882  if (multiescaped) goto step9;
883  step8:
884  if (i>=MAXTOKENLENGTH) error(E_LONGSTRING);
885  ch=readch(ins);
886  if (ch==EOF) goto step10;
887  if (ch<0) ch &= 0xff;
888  ctype=syntaxtype(ch);
889  switch(ctype) {
890  case ch_constituent: case ch_nontermacro:
891  if (charattr[ch]==package_marker) colon=i;
892  if (readcase==K_DOWNCASE) ch=to_lower(ch);
893  else if (readcase==K_PRESERVE) ch=ch;
894  else ch=to_upper(ch);
895  token[i++]=ch; goto step8;
896  case ch_sglescape:
897  token[i++]=readch(ins); escaped=1; goto step8;
898  case ch_multiescape:
899  goto step9;
900  case ch_illegal:
901  error(E_ILLCH,makeint(ch)); break;
902  case ch_termmacro:
903  unreadch(ins,ch); goto step10;
904  case ch_white:
905  unreadch(ins,ch); goto step10;
906  default: error(E_USER,(pointer)"unknown char type");}
907  step9:
908  escaped=1;
909  if (i>=MAXTOKENLENGTH) error(E_LONGSTRING);
910  ch=readch(ins);
911  if (ch==EOF) error(E_EOF);
912  ch &= 0xff;
913  ctype=syntaxtype(ch);
914  switch(ctype) {
915  case ch_constituent: case ch_white:
916  case ch_nontermacro: case ch_termmacro:
917  token[i++]=ch; goto step9;
918  case ch_sglescape:
919  ch=readch(ins); token[i++]=ch; goto step9;
920  case ch_multiescape:
921  goto step8;
922  default: error(E_ILLCH,makeint(ch));}
923  step10:
924  /*token is accumulated; analyze syntax*/
925  token[i]=0;
926  if (escaped) return(readsymbol(ctx,i,colon,token));
927  base=intval(Spevalof(READBASE));
928 
929  j=0;
930  if ((token[j]=='+') || (token[j]=='-')) j++;
931  else if (token[j]=='.' && token[j+1]=='\0')
932  return(readsymbol(ctx,i,colon,token));
933  if (is_digit(token[j],base) || token[j]=='.') {
934  while (is_digit(token[j],base)) j++;
935  if (token[j] == '.') { /*float?*/
936  if (++j==i) return(readint(ctx,token,i));
937  /*float or symbol*/
938  while (is_digit(token[j],base)) j++;
939  c=to_upper(token[j]);
940  if (c=='E' || c=='D' || c=='F' || c=='L') {
941  c=j; j++;
942  if ((token[j]=='+') || (token[j]=='-')) j++;
943  while (is_digit(token[j],base)) j++;
944  if (j==i) { token[c]='E'; return(makeflt(atof(token)));}
945  else return(readsymbol(ctx,i,colon,token));}
946  else if (j==i) return(makeflt(atof(token)));
947  else return(readsymbol(ctx,i,colon,token));}
948  else if (token[j] == '/') { /* ratio? */
949  slash=j;
950  if (++j==i) return(readsymbol(ctx,i,colon,token));
951  /*ratio or symbol*/
952  while (is_digit(token[j],base)) j++;
953  if (j==i) return(readratio(ctx,token,slash));
954  else return(readsymbol(ctx,i,colon,token));}
955  else if (j==i) return(readint(ctx,token,i));
956  else {
957  c=to_upper(token[j]);
958  if (c=='E' || c=='D' || c=='F' || c=='L') {
959  c=j; j++;
960  if ((token[j]=='+') || (token[j]=='-')) j++;
961  while (is_digit(token[j],base)) j++;
962  if (j==i) {/*all digits*/ token[c]='E'; return(makeflt(atof(token)));}
963  else return(readsymbol(ctx,i,colon,token));}
964  else if (j==i) return(makeflt(atof(token)));
965  else return(readsymbol(ctx,i,colon,token));} }
966  else return(readsymbol(ctx,i,colon,token));}
967 
968 static pointer read1(ctx,ins)
969 register context *ctx;
970 register pointer ins;
971 { register enum ch_type ctype;
972  register int firstch;
973  register pointer macrofunc,result;
974  pointer (*intmac)();
975  int colon;
976 /* Char ch; */
977  int ch;
978  char token[MAXTOKENLENGTH];
979  pointer readcase;
980 
981  colon= -1;
982  step1:
983  ch=readch(ins);
984  if (ch==EOF) return((pointer)EOF);
985  ch &= 0xff;
986  firstch=ch;
987  ctype=syntaxtype(ch);
988  switch(ctype) {
989  case ch_illegal: error(E_ILLCH,makeint(ch));
990  case ch_white: goto step1;
991  case ch_termmacro: case ch_nontermacro:
992  macrofunc=Spevalof(QREADTABLE)->c.rdtab.macro->c.vec.v[ch];
993  if (macrofunc==NIL) error(E_USER,(pointer)"no char macro defined");
994  if (isint(macrofunc)) { /*internal macro*/
995  intmac=(pointer (*)())(intval(macrofunc));
996  result=(*intmac)(ctx,ins,ch,token);}
997  else {
998  vpush(ins); vpush(makeint(ch));
999  result=ufuncall(ctx,macrofunc,macrofunc,(pointer)(ctx->vsp-2),NULL,2);
1000  ctx->vsp-=2;}
1001 /* if (result==UNBOUND && firstch!=')') goto step1;
1002  else return(result);*/
1003  return(result);
1004  case ch_sglescape: token[0]=readch(ins);
1005  return(read2(ctx,ins,1,0,1,token,colon));
1006  case ch_multiescape: return(read2(ctx,ins,1,1,0,token,colon));
1007  case ch_constituent:
1008  if (charattr[ch]==package_marker) colon=0;
1009  readcase=Spevalof(QREADTABLE)->c.rdtab.readcase;
1010  if (readcase==K_DOWNCASE) ch=to_lower(ch);
1011  else if (readcase==K_PRESERVE) ch=ch;
1012  else ch=to_upper(ch);
1013  token[0]= ch;
1014  return(read2(ctx,ins,0,0,1,token,colon));}}
1015 
1016 pointer reader(ctx,f,recursivep)
1017 register context *ctx;
1018 register pointer f,recursivep;
1019 { register pointer val;
1020  Char ch;
1021  current_syntax[thr_self()]=Spevalof(QREADTABLE)->c.rdtab.syntax->c.str.chars;
1022  ch=nextch(ctx,f);
1023  if (ch==EOF) return((pointer)EOF);
1024  while (ch==')') ch=nextch(ctx,f);
1025  unreadch(f,ch);
1026  if (recursivep==NIL) {
1027  pointer_update(oblabels[thr_self()]->c.lab.next,NIL);
1028  val=read1(ctx,f);
1029  pointer_update(oblabels[thr_self()]->c.lab.next,NIL);}
1030  else val=read1(ctx,f); /*if called recursively, keep #n= scope*/
1031  if (val==UNBOUND) return(NIL);
1032  return(val);}
1033 
1034 void initreader(ctx)
1035 register context *ctx;
1036 { register pointer rdtable;
1037  register int i;
1038 
1039  charmacro['(']=makeint((eusinteger_t)readlist);
1040  charmacro[')']=makeint((eusinteger_t)readrparen);
1041  charmacro['#']=makeint((eusinteger_t)readsharp);
1042  charmacro['\'']=makeint((eusinteger_t)readquote);
1043  charmacro['"']=makeint((eusinteger_t)readstring);
1044  charmacro[';']=makeint((eusinteger_t)readcomment);
1045 
1046  sharpmacro['\\']=makeint((eusinteger_t)read_sharp_char);
1047  sharpmacro['\'']=makeint((eusinteger_t)read_sharp_function);
1048  sharpmacro[':']=makeint((eusinteger_t)read_uninterned_symbol);
1049  sharpmacro[',']=makeint((eusinteger_t)read_sharp_eval);
1050  sharpmacro['.']=makeint((eusinteger_t)read_sharp_eval);
1051  sharpmacro['|']=makeint((eusinteger_t)read_sharp_comment);
1052  sharpmacro['+']=makeint((eusinteger_t)read_cond_plus);
1053  sharpmacro['-']=makeint((eusinteger_t)read_cond_minus);
1054  sharpmacro['#']=makeint((eusinteger_t)readlabref);
1055  sharpmacro['=']=makeint((eusinteger_t)readlabdef);
1056  sharpmacro['(']=makeint((eusinteger_t)readvector);
1057  sharpmacro['<']=makeint((eusinteger_t)read_sharp_object);
1058  sharpmacro['X']=makeint((eusinteger_t)read_sharp_hex);
1059  sharpmacro['O']=makeint((eusinteger_t)read_sharp_octal);
1060  sharpmacro['S']=makeint((eusinteger_t)readstructure);
1061  sharpmacro['F']=makeint((eusinteger_t)readfvector);
1062  sharpmacro['I']=makeint((eusinteger_t)readivector);
1063  sharpmacro['J']=makeint((eusinteger_t)readobject);
1064  sharpmacro['V']=makeint((eusinteger_t)readobject);
1065 
1066  /* make default readtable */
1067  rdtable=(pointer)makereadtable(ctx);
1068  pointer_update(Spevalof(QREADTABLE),rdtable);
1069  for (i=0; i<256; i++) {
1070  rdtable->c.rdtab.syntax->c.str.chars[i]=(int)chartype[i];
1071  rdtable->c.rdtab.macro->c.vec.v[i]=charmacro[i];
1072  rdtable->c.rdtab.dispatch->c.vec.v[i]=sharpmacro[i];
1073  rdtable->c.rdtab.readcase=K_UPCASE;
1074  }
1075  }
findlabel
static pointer findlabel(eusinteger_t labx)
Definition: reader.c:227
numunion
Definition: eus.h:428
cell::cellunion::cls
struct _class cls
Definition: eus.h:418
complement_big
void complement_big(pointer x)
Definition: big.c:475
buf
static char buf[CHAR_SIZE]
Definition: helpsub.c:23
read_delimited_list
pointer read_delimited_list(context *ctx, pointer f, int delim_char, token)
Definition: reader.c:780
NIL
pointer NIL
Definition: eus.c:110
READBASE
pointer READBASE
Definition: reader.c:29
unreadch
int unreadch(pointer, int)
Definition: eusstream.c:138
C_FLTVECTOR
pointer C_FLTVECTOR
Definition: eus.c:146
QUOTE
pointer QUOTE
Definition: eus.c:110
makereadtable
pointer makereadtable(context *)
Definition: makes.c:523
readlist
static pointer readlist(context *ctx, pointer f, char ch, token)
Definition: reader.c:812
labref::value
pointer value
Definition: eus.h:295
FALSE
#define FALSE
Definition: arith.h:20
addunsolved
static void addunsolved(pointer labp, pointer *addr)
Definition: reader.c:264
readobject
static pointer readobject(context *ctx, pointer s)
Definition: reader.c:383
makeint
#define makeint(v)
Definition: sfttest.c:2
context
Definition: eus.h:524
mul_int_big
void mul_int_big()
E_READ
@ E_READ
Definition: eus.h:945
s
short s
Definition: structsize.c:2
E_NOCLASS
@ E_NOCLASS
Definition: eus.h:962
ch_constituent
@ ch_constituent
Definition: eus.h:461
readch
int readch(pointer)
Definition: eusstream.c:114
PACKAGE
pointer PACKAGE
Definition: eus.c:110
floatvector::fv
eusfloat_t fv[1]
Definition: eus.h:309
ch_multiescape
@ ch_multiescape
Definition: eus.h:463
readtable::syntax
pointer syntax
Definition: eus.h:348
makevector
pointer makevector(pointer, int)
Definition: makes.c:417
intval
#define intval(p)
Definition: sfttest.c:1
read_sharp_eval
static pointer read_sharp_eval(context *ctx, pointer f)
Definition: reader.c:552
readint
static pointer readint(context *ctx, char *token, int len)
Definition: reader.c:738
readsharp
static pointer readsharp(context *ctx, pointer f, Char ch, token)
Definition: reader.c:625
T
pointer T
Definition: eus.c:110
skip
static Char skip(context *ctx, pointer f, Char ch)
Definition: reader.c:198
g
static int(* g)()
Definition: cfunc.c:9
pointer
struct cell * pointer
Definition: eus.h:165
readivector
static pointer readivector(context *ctx, pointer s)
Definition: reader.c:334
ch_attr
ch_attr
Definition: eus.h:467
TRUE
#define TRUE
Definition: arith.h:19
chartype
enum ch_type chartype[256]
Definition: reader.c:49
add_int_big
void add_int_big()
eus.h
makestring
pointer makestring(char *, int)
Definition: makes.c:147
C_VECTOR
pointer C_VECTOR
Definition: eus.c:144
ch_sglescape
@ ch_sglescape
Definition: eus.h:462
E_LONGSTRING
@ E_LONGSTRING
Definition: eus.h:947
searchpkg
pointer searchpkg(byte *, int)
Definition: makes.c:180
makeobject
pointer makeobject(pointer)
Definition: makes.c:407
E_NOPACKAGE
@ E_NOPACKAGE
Definition: eus.h:973
read_sharp_char
static pointer read_sharp_char(context *ctx, pointer f, eusinteger_t val, int subchar)
Definition: reader.c:458
read1
static pointer read1(context *, pointer)
Definition: reader.c:968
ch
int ch[MAXTHREAD]
Definition: eusstream.c:23
cell::cellunion::ivec
struct intvector ivec
Definition: eus.h:416
E_READLABEL
@ E_READLABEL
Definition: eus.h:991
E_TYPEMISMATCH
@ E_TYPEMISMATCH
Definition: eus.h:985
intern
pointer intern(context *, char *, int, pointer)
Definition: intern.c:105
string::chars
byte chars[1]
Definition: eus.h:212
eusfloat_t
double eusfloat_t
Definition: eus.h:21
cell::c
union cell::cellunion c
E_EOF
@ E_EOF
Definition: eus.h:959
readfvector
static pointer readfvector(context *ctx, pointer s)
Definition: reader.c:359
E_READFVECTOR
@ E_READFVECTOR
Definition: eus.h:992
QNOT
pointer QNOT
Definition: eus.c:127
head
NODE * head
Definition: eustags.c:198
cons::cdr
pointer cdr
Definition: eus.h:197
oblabels
pointer oblabels[MAXTHREAD]
Definition: reader.c:42
strtol
int strtol(char *str, char **ptr, int base)
Definition: reader.c:717
E_ILLCH
@ E_ILLCH
Definition: eus.h:944
cell::cellunion::rdtab
struct readtable rdtab
Definition: eus.h:420
cell::cellunion::lab
struct labref lab
Definition: eus.h:412
labref::next
pointer next
Definition: eus.h:297
NULL
#define NULL
Definition: transargv.c:8
getobjv
pointer * getobjv(pointer, pointer, pointer)
Definition: eval.c:22
package_marker
@ package_marker
Definition: eus.h:468
fltval
float fltval()
vector::v
pointer v[1]
Definition: eus.h:301
makesymbol
pointer makesymbol(context *, char *, int, pointer)
Definition: makes.c:164
read_sharp_octal
static pointer read_sharp_octal(context *ctx, pointer f, eusinteger_t val, int subchar)
Definition: reader.c:518
sharpmacro
pointer sharpmacro[256]
Definition: eus.c:164
ch_white
@ ch_white
Definition: eus.h:458
E_READOBJECT
@ E_READOBJECT
Definition: eus.h:993
cell::cellunion::cons
struct cons cons
Definition: eus.h:400
read_cond_plus
static pointer read_cond_plus(context *ctx, pointer f)
Definition: reader.c:585
findsymbol
int findsymbol(char *s)
Definition: contrib/vxworks/vxwserv.c:74
K_DOWNCASE
pointer K_DOWNCASE
Definition: eus.c:134
object::iv
pointer iv[2]
Definition: eus.h:321
read_cond_minus
static pointer read_cond_minus(context *ctx, pointer f)
Definition: reader.c:596
readlabdef
static pointer readlabdef(context *ctx, pointer f, eusinteger_t labx)
Definition: reader.c:237
read_uninterned_symbol
static pointer read_uninterned_symbol(context *ctx, pointer f, eusinteger_t val, int subchar, token)
Definition: reader.c:538
readtable::readcase
pointer readcase
Definition: eus.h:351
makelabref
pointer makelabref()
cons
pointer cons(context *, pointer, pointer)
Definition: makes.c:97
eval
pointer eval(context *, pointer)
Definition: eval.c:1622
ch_nontermacro
@ ch_nontermacro
Definition: eus.h:465
readtable::dispatch
pointer dispatch
Definition: eus.h:350
rcsid
static char * rcsid
Definition: reader.c:9
readratio
static pointer readratio(context *ctx, char *token, int slash)
Definition: reader.c:849
readstring
static pointer readstring(context *ctx, pointer f, int terminator)
Definition: reader.c:652
cell::cellunion::obj
struct object obj
Definition: eus.h:417
charmacro
pointer charmacro[256]
Definition: eus.c:163
readrparen
static pointer readrparen(context *ctx, pointer f)
Definition: reader.c:833
read2
static pointer read2(context *, pointer, int, int, int, char *, int)
readtable::macro
pointer macro
Definition: eus.h:349
reader
pointer reader(context *ctx, pointer f, pointer recursivep)
Definition: reader.c:1016
makeratio
pointer makeratio()
makeflt
pointer makeflt()
current_syntax
byte * current_syntax[MAXTHREAD]
Definition: reader.c:41
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
package::symvector
pointer symvector
Definition: eus.h:222
labref::unsolved
pointer unsolved
Definition: eus.h:296
K_UPCASE
pointer K_UPCASE
Definition: eus.c:134
f
f
read_sharp_comment
static pointer read_sharp_comment(context *ctx, pointer f, eusinteger_t val, int subchar)
Definition: reader.c:466
alphabetic
@ alphabetic
Definition: eus.h:468
labref::label
pointer label
Definition: eus.h:294
cell
Definition: eus.h:381
illegal
@ illegal
Definition: eus.h:468
eusinteger_t
long eusinteger_t
Definition: eus.h:19
normalize_bignum
pointer normalize_bignum()
makebig
pointer makebig()
keywordpkg
pointer keywordpkg
Definition: eus.c:109
charattr
enum ch_attr charattr[256]
Definition: reader.c:115
nextch
static int nextch(context *ctx, pointer f)
Definition: reader.c:215
ch_illegal
@ ch_illegal
Definition: eus.h:457
alphadigit
@ alphadigit
Definition: eus.h:468
E_EXTSYMBOL
@ E_EXTSYMBOL
Definition: eus.h:1002
FEATURES
pointer FEATURES
Definition: eus.c:172
QOR
pointer QOR
Definition: reader.c:30
cons::car
pointer car
Definition: eus.h:196
readstructure
static pointer readstructure(context *ctx, pointer s)
Definition: reader.c:422
QREADTABLE
pointer QREADTABLE
Definition: reader.c:29
QAND
pointer QAND
Definition: reader.c:30
is_digit
int is_digit(int ch, int base)
Definition: reader.c:770
read_sharp_object
static pointer read_sharp_object(context *ctx, pointer f)
Definition: reader.c:607
C_INTVECTOR
pointer C_INTVECTOR
Definition: eus.c:146
eval_read_cond
static pointer eval_read_cond(context *ctx, pointer expr)
Definition: reader.c:560
E_USER
@ E_USER
Definition: eus.h:1006
ufuncall
pointer ufuncall(context *, pointer, pointer, pointer, struct bindframe *, int)
Definition: eval.c:1469
intvector::iv
eusinteger_t iv[1]
Definition: eus.h:305
FUNCTION
pointer FUNCTION
Definition: eus.c:111
read_sharp_hex
static pointer read_sharp_hex(context *ctx, pointer f, eusinteger_t val, int subchar)
Definition: reader.c:485
cell::cellunion::vec
struct vector vec
Definition: eus.h:414
readvector
static pointer readvector(context *ctx, pointer f, int size)
Definition: reader.c:294
makebig1
pointer makebig1()
memq
pointer memq()
cell::cellunion::pkg
struct package pkg
Definition: eus.h:404
E_NOSYMBOL
@ E_NOSYMBOL
Definition: eus.h:948
readsymbol
static pointer readsymbol(context *ctx, int leng, int colon, token)
Definition: reader.c:681
cell::cellunion::fvec
struct floatvector fvec
Definition: eus.h:415
readquote
static pointer readquote(context *ctx, pointer f)
Definition: reader.c:818
readcomment
static pointer readcomment(context *ctx, pointer f)
Definition: reader.c:826
v
GLfloat v[8][3]
Definition: cube.c:21
K_PRESERVE
pointer K_PRESERVE
Definition: eus.c:134
gcd
int gcd(int u, int v)
Definition: reader.c:840
_class::vars
pointer vars
Definition: eus.h:328
read_sharp_function
static pointer read_sharp_function(context *ctx, pointer f, eusinteger_t val, int subchar)
Definition: reader.c:531
cell::cellunion::str
struct string str
Definition: eus.h:402
thr_self
unsigned int thr_self()
Definition: eus.c:25
initreader
void initreader(context *ctx)
Definition: reader.c:1034
ch_type
ch_type
Definition: eus.h:456
ch_termmacro
@ ch_termmacro
Definition: eus.h:464
readlabref
static pointer readlabref(context *ctx, pointer f, eusinteger_t val, int subchar)
Definition: reader.c:278

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