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