reader.c
Go to the documentation of this file.
00001 /****************************************************************/
00002 /* euslisp reader
00003 /*      Copyright (c) T.Matsui, Electrotechnical Laboratory
00004 /*      1986-
00005 /*      1987-Jan        dispatch macros
00006 /*      1987-May        labeled expression #n= and #n#
00007 /*      1988-July       multiple escape |...|
00008 /****************************************************************/
00009 static char *rcsid="@(#)$Id$";
00010 
00011 #include <ctype.h>
00012 #include <fcntl.h>
00013 #include <signal.h>
00014 #include <string.h>
00015 #include "eus.h"
00016 
00017 #if !alpha
00018 #define FALSE (0)
00019 #define TRUE (1)
00020 #endif
00021 
00022 #define MAXTOKENLENGTH  1024
00023 #define MAXSTRINGLENGTH 16384
00024 #define to_upper(c) (islower(c) ? ((c)-'a'+'A') : (c))
00025 #define to_lower(c) (isupper(c) ? ((c)-'A'+'a') : (c))
00026 
00027 #define syntaxtype(ch) ((enum ch_type)(current_syntax[thr_self()][ch]))
00028 
00029 extern pointer FEATURES,READBASE,QREADTABLE;
00030 extern pointer QNOT, QAND, QOR; /*eval_read_cond, Jan/1995*/
00031 
00032 static pointer read1(context *, pointer);
00033 static pointer read2(context *, pointer, int, int, int, char*, int);
00034 extern pointer makelabref();
00035 
00036 extern void mul_int_big();
00037 extern pointer normalize_bignum();
00038 
00039 /* the following two global variables are hazardous to multi-threads */
00040 /* These should be eliminated in the next release. */
00041 byte *current_syntax[MAXTHREAD];
00042 pointer oblabels[MAXTHREAD];    /*keep labeled-objects in read*/
00043 
00044 /****************************************************************/
00045 /* character type table
00046 /****************************************************************/
00047 
00048 /*exported*/
00049 enum ch_type chartype[256]={
00050         ch_illegal,     ch_illegal,     ch_illegal,     ch_illegal, /*0-3*/
00051         ch_illegal,     ch_illegal,     ch_illegal,     ch_illegal, /*4-7*/
00052         ch_constituent, ch_white,       ch_white,       ch_illegal, /*8-b*/
00053         ch_white,       ch_white,       ch_illegal,     ch_illegal, /*c-f*/
00054         ch_illegal,     ch_illegal,     ch_illegal,     ch_illegal, /*10-13*/
00055         ch_illegal,     ch_illegal,     ch_illegal,     ch_illegal, /*14-17*/
00056         ch_illegal,     ch_illegal,     ch_illegal,     ch_illegal, /*18-1b*/
00057         ch_illegal,     ch_illegal,     ch_illegal,     ch_illegal, /*1c-1f*/
00058         ch_white,       ch_constituent, ch_termmacro,   ch_nontermacro,   /*20-23*/
00059         ch_constituent, ch_constituent, ch_constituent, ch_termmacro,   /*24-27*/
00060         ch_termmacro,   ch_termmacro,   ch_constituent, ch_constituent, /*28-2b*/
00061         ch_termmacro,   ch_constituent, ch_constituent, ch_constituent, /*2c-2f*/
00062         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*30-33*/
00063         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*34-37*/
00064         ch_constituent, ch_constituent, ch_constituent, ch_termmacro,    /*38-3b*/
00065         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*3c-3f*/
00066         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*40-43*/
00067         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*44-47*/
00068         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*48-4b*/
00069         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*4c-4f*/
00070         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*50-53*/
00071         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*54-57*/
00072         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*58-5b*/
00073         ch_sglescape,   ch_constituent, ch_constituent, ch_constituent, /*5c-5f*/
00074         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*60-63*/
00075         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*64-67*/
00076         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*68-6b*/
00077         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*6c-6f*/
00078         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*70-73*/
00079         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*74-77*/
00080         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*78-7b*/
00081         ch_multiescape, ch_constituent, ch_constituent, ch_constituent, /*7c-7f*/
00082         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*80*/
00083         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00084         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00085         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00086         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*90*/
00087         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00088         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00089         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00090         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*a0*/
00091         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00092         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00093         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00094         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*b0*/
00095         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00096         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00097         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00098         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*c0*/
00099         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00100         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00101         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00102         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*d0*/
00103         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00104         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00105         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00106         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*e0*/
00107         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00108         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00109         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00110         ch_constituent, ch_constituent, ch_constituent, ch_constituent, /*f0*/
00111         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00112         ch_constituent, ch_constituent, ch_constituent, ch_constituent, 
00113         ch_constituent, ch_constituent, ch_constituent, ch_constituent};
00114 
00115 enum ch_attr charattr[256]={
00116         illegal,        illegal,        illegal,        illegal,        /*0*/
00117         illegal,        illegal,        illegal,        illegal,
00118         illegal,        illegal,        illegal,        illegal,
00119         illegal,        illegal,        illegal,        illegal,
00120         illegal,        illegal,        illegal,        illegal,        /*10*/
00121         illegal,        illegal,        illegal,        illegal,
00122         illegal,        illegal,        illegal,        illegal,
00123         illegal,        illegal,        illegal,        illegal,
00124         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*20*/
00125         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00126         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00127         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00128         alphadigit,     alphadigit,     alphadigit,     alphadigit,     /*30*/
00129         alphadigit,     alphadigit,     alphadigit,     alphadigit,
00130         alphadigit,     alphadigit,     package_marker, alphabetic,
00131         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00132         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*40*/
00133         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00134         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00135         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00136         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*50*/
00137         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00138         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00139         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00140         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*60*/
00141         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00142         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00143         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00144         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*70*/
00145         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00146         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00147         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00148         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*80*/
00149         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00150         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00151         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00152         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*90*/
00153         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00154         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00155         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00156         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*a0*/
00157         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00158         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00159         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00160         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*b0*/
00161         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00162         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00163         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00164         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*c0*/
00165         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00166         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00167         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00168         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*d0*/
00169         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00170         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00171         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00172         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*e0*/
00173         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00174         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00175         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00176         alphabetic,     alphabetic,     alphabetic,     alphabetic,     /*f0*/
00177         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00178         alphabetic,     alphabetic,     alphabetic,     alphabetic,
00179         alphabetic,     alphabetic,     alphabetic,     alphabetic
00180         };
00181 
00182 /****************************************************************/
00183 /* euLisp READER                                                */
00184 /****************************************************************/
00185 /*
00186 /* reader primitives
00187 */
00188 #if IRIX || Linux_ppc
00189 #define Char int
00190 #else
00191 #if ARM
00192 #define Char signed char
00193 #else
00194 #define Char char
00195 #endif
00196 #endif
00197 
00198 static Char skip(ctx, f, ch)
00199 context *ctx;
00200 register pointer f;
00201 Char ch;
00202 { skipblank:
00203   while (syntaxtype((char)ch)==ch_white) {
00204     ch=readch(f);
00205     if (ch==EOF) return(EOF);}
00206   if (ch == ';' && (Spevalof(QREADTABLE)->c.rdtab.macro->c.vec.v[ch]
00207                 == charmacro[';'])) {
00208     /*syntax type for comment should be checked*/
00209     do {
00210       ch=readch(f);
00211       if (ch==EOF) return(EOF); }
00212       while(ch!='\n');
00213     goto skipblank;}  return(ch); }
00214 
00215 static int nextch(ctx, f)
00216 context *ctx;
00217 register pointer f;
00218 { 
00219   Char ch;
00220   ch=readch(f); ch=skip(ctx, f,ch); return(ch);}
00221 
00222 
00223 /****************************************************************/
00224 /*  labeled expression (#n=, #n#)
00225 /****************************************************************/
00226 
00227 static pointer findlabel(labx)
00228 eusinteger_t labx;
00229 { register pointer obj,labid;
00230   labid=makeint(labx);
00231   obj=oblabels[thr_self()]->c.lab.next;
00232   while (obj!=NIL) {
00233     if (obj->c.lab.label==labid) return(obj);
00234     else obj=obj->c.lab.next; }
00235   return(NIL);}
00236 
00237 static pointer readlabdef(ctx,f,labx)
00238 context *ctx;
00239 pointer f;      /*stream*/
00240 eusinteger_t labx;
00241 { pointer  unsol, *unsolp, result,newlab;
00242 
00243   if (findlabel(labx)!=NIL)  error(E_READLABEL,makeint(labx));  /*already defined*/
00244   newlab=(pointer)makelabref(makeint(labx),UNBOUND,oblabels[thr_self()]->c.lab.next);
00245   pointer_update(oblabels[thr_self()]->c.lab.next,newlab);
00246   result=read1(ctx,f);
00247 
00248   /*solve references*/
00249   pointer_update(newlab->c.lab.value,result);
00250   unsol=newlab->c.lab.unsolved;
00251   while (unsol!=NIL) {
00252 #if sun3 || (!alpha && system5) || sanyo
00253     unsolp=(pointer *)unsol;
00254 #endif
00255 #if sun4 || vax || news || mips || alpha || i386
00256     unsolp=(pointer *)((eusinteger_t)unsol & ~3);/*???? */
00257 #elif (WORD_SIZE == 64)
00258     unsolp=(pointer *)((eusinteger_t)unsol & ~3L);/*???? */
00259 #endif
00260     unsol= *unsolp;
00261     pointer_update(*unsolp,result); }
00262   return(result);}
00263 
00264 static addunsolved(labp,addr)
00265 pointer labp;
00266 pointer *addr;
00267 { pointer_update(*addr,labp->c.lab.unsolved);
00268 #if sun3 ||( !alpha && system5 ) || sanyo
00269   labp->c.lab.unsolved=(pointer)addr;
00270 #endif
00271 #if sun4 || vax || news || mips || alpha || i386 || x86_64 || ARM
00272   { eusinteger_t i;
00273     i=(((eusinteger_t)addr)>>2);
00274     labp->c.lab.unsolved=makeint(i);}
00275 #endif
00276 }
00277 
00278 static pointer readlabref(ctx,f,val,subchar)
00279 pointer f;
00280 eusinteger_t val;
00281 int subchar;
00282 { register pointer obj,element;
00283   obj=findlabel(val);
00284   if (obj==NIL) error(E_READLABEL,makeint(val));        /*undefined label*/
00285   if ((element=obj->c.lab.value)==UNBOUND) return(obj);
00286   else return(element);}
00287 
00288 
00289 /****************************************************************/
00290 /* read vector and object
00291 /* #(, #v(, #f(, #i(, #j(
00292 /****************************************************************/
00293 static pointer readvector(ctx,f,size)
00294 register context *ctx;
00295 register pointer f;
00296 register int size;
00297 { register pointer result,element;
00298   register int i=0;
00299   Char ch;
00300   ch=nextch(ctx,f);
00301   if (size>0) {
00302     result=makevector(C_VECTOR,size);
00303     vpush(result);
00304     while ((ch!=')') && (ch!=EOF) && (i<size)) {
00305       unreadch(f,ch);
00306       element=read1(ctx,f);
00307       if (islabref(element)) {  /*refer to undefined labeled obj*/
00308         addunsolved(element,&result->c.vec.v[i]); }
00309       else pointer_update(result->c.vec.v[i],element);
00310       i++;
00311       ch=nextch(ctx,f);}
00312     if (ch==')') 
00313       while (i<size) {pointer_update(result->c.vec.v[i],element);i++;}
00314     else {
00315       while (ch!=')' && ch!=EOF) ch=nextch(ctx,f);
00316       error(E_READ); }
00317     return(result);}
00318   else {
00319     while ((ch!=')') && (ch!=EOF)) {
00320       unreadch(f,ch);
00321       element=read1(ctx,f);
00322       ckpush(element);
00323       i++;
00324       ch=nextch(ctx,f);}
00325     result=makevector(C_VECTOR,i);
00326     while (i>0) {
00327       i--;
00328       element=vpop();
00329       if (islabref(element)) addunsolved(element,&result->c.vec.v[i]);
00330       else pointer_update(result->c.vec.v[i],element); }
00331     return(result); } }
00332 
00333 static pointer readivector(ctx,s)
00334 register context *ctx;
00335 register pointer s;
00336 { register int i=0;
00337   register eusinteger_t x;
00338   register pointer elm;
00339   register pointer rvec;
00340   Char ch;
00341   ch=nextch(ctx,s);
00342   if (ch!='(') error(E_READFVECTOR);
00343   ch=nextch(ctx,s);
00344   while (ch!=')' && ch!=EOF) {
00345     unreadch(s,ch);
00346     elm=read1(ctx,s);
00347     x=ckintval(elm);
00348     ch=nextch(ctx,s);
00349     vpush(elm);
00350     i++;}
00351   rvec=makevector(C_INTVECTOR,i);
00352   while (i>0) {
00353     elm=vpop();
00354     x=bigintval(elm);
00355     rvec->c.ivec.iv[--i]=x;}
00356   return(rvec);}
00357 
00358 static pointer readfvector(ctx,s)
00359 register context *ctx;
00360 register pointer s;
00361 { register int i=0,x;
00362   register pointer elm;
00363   eusfloat_t f;
00364   Char ch;
00365   numunion nu;
00366 
00367   ch=nextch(ctx,s);
00368   if (ch!='(') error(E_READFVECTOR);
00369   ch=nextch(ctx,s);
00370   while (ch!=')' && ch!=EOF) {
00371     unreadch(s,ch);
00372     elm=read1(ctx,s);
00373     if (!isnum(elm)) error(E_READFVECTOR);
00374     if (isint(elm)) { f=intval(elm); elm=makeflt(f);}
00375     ckpush(elm);
00376     i++;
00377     ch=nextch(ctx,s);}
00378   elm=makevector(C_FLTVECTOR,i);
00379   while (i>0) elm->c.fvec.fv[--i]=fltval(vpop());
00380   return(elm);}
00381 
00382 static pointer readobject(ctx,s)
00383 register context *ctx;
00384 register pointer s;     /*input stream*/
00385 {
00386   register pointer name, klass, elem, result;
00387   register eusinteger_t sz;
00388   register int i;
00389   Char ch;
00390 
00391   ch=nextch(ctx,s);
00392   if (ch!='(') error(E_READOBJECT);
00393   name=read1(ctx,s);
00394   if (!issymbol(name)) error(E_READOBJECT);
00395   klass=speval(name);
00396   if (klass==UNBOUND) error(E_NOCLASS,name);
00397   if (!isclass(klass)) error(E_READOBJECT);
00398   if (isvecclass(klass)) {
00399     elem=read1(ctx,s);
00400     if (!isint(elem)) error(E_READOBJECT);      /*vector size*/
00401     sz=intval(elem);
00402     result=makevector(klass,sz);
00403     i=1;}
00404   else if (isclass(klass)) {
00405     result=(pointer)makeobject(klass);
00406     i=0;}
00407   else error(E_NOCLASS,name);
00408   vpush(result);
00409   ch=nextch(ctx,s);
00410   while (ch!=')' && ch!=EOF) {
00411     unreadch(s,ch);
00412     elem=read1(ctx,s);
00413     if (islabref(elem)) {       /*refer to undefined labeled obj*/
00414         addunsolved(elem,&result->c.obj.iv[i++]); }
00415     else result->c.obj.iv[i++]=elem;
00416     ch=nextch(ctx,s);
00417     }
00418   vpop();
00419   return(result); }
00420 
00421 static pointer readstructure(ctx,s)
00422 register context *ctx;
00423 register pointer s;     /*input stream*/
00424 { register pointer name, klass, slot, elem, result, varvec, *slotp;
00425   Char ch;
00426 
00427   ch=nextch(ctx,s);
00428   if (ch!='(') error(E_READOBJECT);
00429   name=read1(ctx,s);
00430   if (!issymbol(name)) error(E_READOBJECT);
00431   klass=speval(name);
00432   if (klass==UNBOUND) error(E_NOCLASS,name);
00433   if (!isclass(klass)) error(E_READOBJECT);
00434   if (isvecclass(klass)) { error(E_NOCLASS,name);}
00435   else if (isclass(klass)) result=(pointer)makeobject(klass);
00436   else error(E_NOCLASS,name);
00437   vpush(result);
00438   ch=nextch(ctx,s);
00439   while (ch!=')' && ch!=EOF) {
00440     unreadch(s,ch);
00441     slot=read1(ctx,s);
00442     if (!issymbol(slot)) error(E_NOSYMBOL);
00443     elem=read1(ctx,s);
00444     slotp=(pointer *)getobjv(slot,klass->c.cls.vars,result);
00445     if (slotp!=NULL) {
00446       if (islabref(elem)) {     /*refer to undefined labeled obj*/
00447         addunsolved(elem,slotp); }
00448       else pointer_update(*slotp,elem); }
00449     ch=nextch(ctx,s);
00450     }
00451   vpop();
00452   return(result); }
00453 
00454 /****************************************************************/
00455 /* read dispatch macro expression
00456 /****************************************************************/
00457 static pointer read_sharp_char(ctx,f,val,subchar)       /* #\ */
00458 register context *ctx;
00459 register pointer f;
00460 eusinteger_t val;
00461 int subchar;
00462 { char ch;
00463   ch=readch(f); return(makeint(ch));}
00464 
00465 static pointer read_sharp_comment(ctx,f,val,subchar)    /* #| ... |# */
00466 register context *ctx;
00467 register pointer f;
00468 register eusinteger_t val;
00469 register int subchar;
00470 { Char ch;
00471   val=0;
00472   ch=readch(f);
00473  morecomments:
00474   while (ch!=subchar && ch!='#' && ch!=EOF) ch=readch(f);
00475   if (ch==EOF) return((pointer)EOF);
00476   if (ch==subchar) {
00477     ch=readch(f);
00478     if (ch=='#') { if (--val<0) return(UNBOUND);}
00479     goto morecomments;}
00480   ch=readch(f);
00481   if (ch==subchar)  { ch=readch(f); val++;}
00482   goto morecomments;}
00483 
00484 static pointer read_sharp_hex(ctx,f,val,subchar)
00485 register context *ctx;
00486 register pointer f;
00487 eusinteger_t val;
00488 int subchar;
00489 { register int i=0,j,c,p,q;
00490   pointer b;
00491   eusinteger_t *bv,x;
00492   char ch, buf[WORD_SIZE];
00493 
00494   ch=readch(f);
00495   while (i<WORD_SIZE && isxdigit(ch)) { buf[i++] = ch; ch=readch(f);}
00496   unreadch(f,ch); buf[i]=0;
00497   j = i*4 - (buf[0]<'2' ? 3 :
00498              buf[0]<'4' ? 2 :
00499              buf[0]<'8' ? 1 : 0); /* alphabet is bigger than '9'*/
00500   if (j<WORD_SIZE-2) { sscanf(buf,"%lx",&val);  return(makeint(val));}
00501   else {
00502     b= (pointer)makebig((j+WORD_SIZE-2)/(WORD_SIZE-1));
00503     bv=bigvec(b);
00504     p=0;q=0;
00505     for (j=i-1; j>=0; j--) {
00506       c=toupper(buf[j]);
00507       x=(c<='9')?(c-'0'):(c-'A'+10);
00508       bv[p/(WORD_SIZE-1)] |= ((x << q) & MASK);
00509       if (q>=(WORD_SIZE-4) && (x>>(WORD_SIZE-1-q)))
00510         bv[p/(WORD_SIZE-1) + 1] = x>>(WORD_SIZE-1-q);
00511       p +=4; q = (q+4) % (WORD_SIZE-1);
00512       }
00513     b=(pointer)normalize_bignum(b);
00514     return(b);}
00515   }
00516 
00517 static pointer read_sharp_octal(ctx,f,val,subchar)
00518 register context *ctx;
00519 pointer f;
00520 eusinteger_t val;
00521 int subchar;
00522 { register int i=0;
00523   char buf[WORD_SIZE/2], ch;
00524   ch=readch(f); val=0;
00525   while (i<WORD_SIZE/2 && ch>='0' && ch<'8') { buf[i++] = ch; ch=readch(f);}
00526   unreadch(f,ch); buf[i]=0;
00527   sscanf(buf,"%lo",&val);
00528   return(makeint(val));}
00529 
00530 static pointer read_sharp_function(ctx,f,val,subchar)   /* #' */
00531 register context *ctx;
00532 pointer f;
00533 eusinteger_t val;
00534 int subchar;
00535 { return(cons(ctx,FUNCTION,cons(ctx,read1(ctx,f),NIL)));}
00536 
00537 static pointer read_uninterned_symbol(ctx,f,val,subchar,token)  /* #: */
00538 context *ctx;
00539 pointer f;
00540 eusinteger_t val;
00541 int subchar;
00542 char token[];
00543 { register int i=0;
00544   char ch;
00545   ch=readch(f);
00546   while (syntaxtype(ch)==ch_constituent) {
00547     token[i++]=to_upper(ch); ch=readch(f);}
00548   token[i]=0; unreadch(f,ch);
00549   return(makesymbol(ctx,(char *)token,i,NIL));}
00550 
00551 static pointer read_sharp_eval(ctx,f)
00552 register context *ctx;
00553 pointer f;
00554 { pointer p;
00555   p=read1(ctx,f);
00556 /*  if (debug) prinx(ctx,p,Spevalof(QSTDOUT)); */
00557   return(eval(ctx,p));}
00558 
00559 static pointer eval_read_cond(ctx,expr)
00560 context *ctx;
00561 pointer expr;
00562 { pointer r;
00563   if (issymbol(expr)) return(memq(expr,speval(FEATURES)));
00564   if (iscons(expr)) {
00565     if (ccar(expr)==QNOT) {
00566       r=eval_read_cond(ctx,ccar(ccdr(expr)));
00567       return((r==NIL)?T:NIL);}
00568     else if (ccar(expr)==QAND) {
00569       expr=ccdr(expr);
00570       while (iscons(expr)) {
00571         r=eval_read_cond(ctx,ccar(expr));
00572         if (r==NIL) return(NIL);
00573         else expr=ccdr(expr);}
00574       return(T);}
00575     else if (ccar(expr)==QOR) {
00576       expr=ccdr(expr);
00577       while (iscons(expr)) {
00578         r=eval_read_cond(ctx,ccar(expr));
00579         if (r!=NIL) return(T);
00580         else expr=ccdr(expr);}
00581       return(NIL);}}
00582   error(E_USER,(pointer)"AND/OR/NOT expected in #+ or #-", expr);}
00583 
00584 static pointer read_cond_plus(ctx,f)    /* #+ */
00585 register context *ctx;
00586 register pointer f;
00587 { register pointer flag,result;
00588   flag=read1(ctx,f);
00589   vpush(flag);
00590   result=read1(ctx,f);
00591   if (eval_read_cond(ctx,flag)==NIL) result=(pointer)UNBOUND;
00592   vpop();
00593   return(result);}
00594 
00595 static pointer read_cond_minus(ctx,f)   /* #- */
00596 register context *ctx;
00597 register pointer f;
00598 { register pointer flag,result;
00599   flag=read1(ctx,f);
00600   vpush(flag);
00601   result=read1(ctx,f);
00602   if (eval_read_cond(ctx,flag)!=NIL) result=(pointer)UNBOUND;
00603   vpop();
00604   return(result);}
00605 
00606 static pointer read_sharp_object(ctx,f) /* #< */
00607 register context *ctx;
00608 register pointer f;
00609 { register pointer element,result,obj;
00610   register eusinteger_t val;
00611   Char ch;
00612   element=read1(ctx,f);
00613   if (!issymbol(element)) error(E_NOSYMBOL);  /*class name*/
00614   element=speval(element);
00615   if (element==UNBOUND || !isclass(element)) error(E_NOCLASS,element);
00616   obj=read1(ctx,f); val=ckintval(obj);
00617   result=makepointer(val);
00618   if (classof(result)!=element)
00619      error(E_TYPEMISMATCH, (pointer)"read #<> class mismatch");   /* ???? */
00620   ch=readch(f);
00621   while (ch!='>' && ch!=EOF) ch=readch(f);
00622   return(result);}
00623 
00624 static pointer readsharp(ctx,f,ch,token)
00625 register context *ctx;
00626 register pointer f;
00627 Char ch;
00628 char token[];
00629 { register eusinteger_t val=0;
00630   register int i=0,subchar;
00631   pointer macrofunc,result;
00632   pointer (*intmac)();
00633 
00634   ch=readch(f);
00635   if (ch==EOF) return(UNBOUND);
00636   while (isdigit(ch)) { 
00637     val=val*10+ch-'0'; ch=nextch(ctx,f);
00638     if (ch==EOF) return(UNBOUND);}
00639   subchar=to_upper(ch);
00640   macrofunc=Spevalof(QREADTABLE)->c.rdtab.dispatch->c.vec.v[subchar];
00641   if (macrofunc==NIL) error(E_USER,(pointer)"no # macro defined");
00642   if (isint(macrofunc)) {       /*internal macro*/
00643     intmac=(pointer (*)())(intval(macrofunc));
00644     result=(*intmac)(ctx,f,val,subchar,token);}
00645   else {
00646     vpush(f); vpush(makeint(subchar)); vpush(makeint(val));
00647     result=ufuncall(ctx,macrofunc,macrofunc,(pointer)(ctx->vsp-3),NULL,3);
00648     ctx->vsp-=3;}
00649   return(result);}
00650 
00651 static pointer readstring(ctx,f,terminator)
00652 register context *ctx;
00653 pointer f;
00654 int terminator;
00655 { int tleng = 0, lengmax=MAXSTRINGLENGTH;      /* '"' is ignored */
00656   byte buf[MAXSTRINGLENGTH], *token, *newtoken;
00657   int ch, malloced=FALSE;
00658   pointer p;
00659 
00660   ch=readch(f);
00661   token=buf;
00662   while ((ch!=terminator) && (ch!=EOF)) {
00663     if (syntaxtype(ch) == ch_sglescape) ch=readch(f);     /*read escaped char*/
00664     token[tleng++]=ch;
00665     if (tleng >= lengmax) { /*allocate bigger string buffer*/
00666                             /*and copy the accumulated characters so far*/
00667       newtoken=(byte *)malloc(lengmax*2);
00668       memcpy(newtoken,token,tleng);
00669       if (malloced==TRUE) cfree(token);
00670       malloced=TRUE;
00671       token=newtoken; lengmax=lengmax*2;
00672       }
00673     ch=readch(f);}
00674   token[tleng] = '\0';
00675   p=makestring((char *)token,tleng);
00676   if (malloced==TRUE) cfree(token);
00677   return(p);
00678   }
00679 
00680 static pointer readsymbol(ctx,leng,colon, token)
00681 register context *ctx;
00682 register int leng,colon;
00683 char token[];
00684 { register pointer pkg;
00685   pointer pkgstr,sym;
00686   register int doublecolon=1;
00687   int hash;
00688   if (colon==0) pkg=keywordpkg;
00689   else if (colon>0) {
00690     if (charattr[token[colon-1]]==package_marker) {
00691       pkg=(pointer)searchpkg((byte *)token,colon-1);}
00692     else {
00693       doublecolon=0;
00694       pkg=(pointer)searchpkg((byte *)token,colon);}
00695     if (pkg==(pointer)NULL) {
00696       if (doublecolon) colon--;
00697       pkgstr=makestring(token,colon);
00698       vpush(pkgstr);
00699       error(E_NOPACKAGE,pkgstr);} }
00700   else pkg=Spevalof(PACKAGE);   /*use current package for symbol search*/
00701   colon++;  /*colon-th character starts symbol name string*/
00702   if (doublecolon) return(intern(ctx,&token[colon],leng-colon,pkg));
00703   else {
00704     sym=findsymbol((byte *)&token[colon],leng-colon, pkg->c.pkg.symvector, &hash);
00705 /*    sym=findsymbol((char *)&token[colon],leng-colon, pkg->c.pkg.symvector, &hash);*/
00706     if (sym) return(sym);
00707     else {
00708       pkgstr=makestring(token,leng);
00709         fprintf(stderr,"%s ",token);
00710       vpush(pkgstr);
00711       error(E_EXTSYMBOL,pkgstr);}
00712   } }
00713 
00714 /* STUPID news does not have strtol routine!*/
00715 #if news || sanyo
00716 int strtol(str,ptr,base)
00717 register char *str,**ptr;
00718 register int base;
00719 { long val=0,sign=1;
00720   char ch;
00721   while (isspace(*str)) str++;
00722   ch= *str;
00723   if (ch=='+') str++; else if (ch=='-') { str++; sign= -1;}
00724   if (base<=10) {
00725     while ('0'<= *str && *str<('0'+base)) val=val*base+(*str++)-'0';
00726     return(sign*val);}
00727   else {
00728     while (1) {
00729       if ('0'<= *str && *str<='9') val=val*base+(*str++ -'0');
00730       else if ('A'<= *str && *str<('A'+base-10)) val=val*base+(*str++ - 'A'+10);
00731       else if ('a'<= *str && *str<('a'+base-10)) val=val*base+(*str++ - 'a'+10);
00732       else break;
00733       continue;}
00734     return(sign*val);}}
00735 #endif
00736 
00737 static pointer readint(ctx,token,len)
00738 context *ctx;
00739 char *token;
00740 int len;
00741 { eusinteger_t base=intval(Spevalof(READBASE));
00742   int head,i,sign=1, k;
00743   pointer b;
00744 
00745   if (len<8) {
00746     i=strtol(token,NULL,base);
00747     return(makeint(i));}
00748   else {
00749     if (token[0]=='+') { head=1;}
00750     else if (token[0]=='-') {head=1; sign= -1;}
00751     else head=0;
00752     b=(pointer)makebig1(0);
00753     vpush(b);
00754     for (i=head; i<len; i++) {
00755       k= (int) token[i];
00756       if (k>='0' && k<='9') k= k-'0';
00757       else if (k>='A' && k<='Z') k=k-'A'+10;
00758       else if (k>='a' && k<='z') k=k-'a'+10;
00759       else if (k=='.') continue;
00760       else error(E_USER,(pointer)"illegal integer consituent char");
00761       mul_int_big(base,b);
00762       add_int_big(k,b);  }
00763     if (sign<0) complement_big(b);
00764     b=(pointer)normalize_bignum(b);
00765     }
00766   ctx->lastalloc= vpop();
00767   return(b);}
00768 
00769 is_digit(ch,base)
00770 register int ch,base;
00771 { if (ch<'0') return(FALSE);
00772   if (base<=10)
00773     if (ch<'0'+base) return(TRUE);
00774     else return(FALSE);
00775   else if (ch<='9') return(TRUE);
00776   else if ('A'<=ch && ch<'A'+base-10) return(TRUE);
00777   else return(FALSE);}
00778 
00779 pointer read_delimited_list(ctx,f,delim_char,token)
00780 register context *ctx;
00781 pointer f;
00782 int delim_char;
00783 char token[];
00784 { pointer result=NIL;
00785   pointer temp,element;
00786   Char ch;
00787   ch=nextch(ctx,f);
00788   vpush(STOPPER);       /*marker*/
00789   while (ch!=delim_char && ch!=EOF) {
00790     if (ch=='.') {
00791       ch=readch(f); unreadch(f,ch);
00792       if (syntaxtype(ch)==ch_constituent) {
00793         token[0]='.';
00794         element=read2(ctx,f,0,0,1,token, -1);}
00795       else if (syntaxtype(ch)==ch_white) {
00796         result=read1(ctx,f);
00797         ch=nextch(ctx,f);
00798         if (ch!=delim_char) error(E_READ);
00799         break;}
00800       else error(E_READ);}
00801     else { unreadch(f,ch);  element=read1(ctx,f);}
00802     if (element!=UNBOUND && element!=(pointer)EOF) ckpush(element);
00803     ch=nextch(ctx,f);}
00804   while ((element=vpop())!=STOPPER) {
00805     temp=cons(ctx,element,result);
00806     if (islabref(element)) addunsolved(element,&temp->c.cons.car);
00807     if (islabref(result)) addunsolved(result,&temp->c.cons.cdr);
00808     result=temp;}
00809   return(result); }
00810 
00811 static pointer readlist(ctx,f,ch,token)
00812 register context *ctx;
00813 pointer f;
00814 char ch, token[];
00815 { return(read_delimited_list(ctx,f,')',token));}
00816 
00817 static pointer readquote(ctx,f)
00818 register context *ctx;
00819 pointer f;
00820 { pointer q;
00821   q=read1(ctx,f);
00822   if (q==(pointer)EOF) return((pointer)EOF);
00823   return(cons(ctx,QUOTE,cons(ctx,q,NIL)));}
00824 
00825 static pointer readcomment(ctx,f)
00826 pointer f;
00827 { register Char ch;
00828   do { ch=readch(f);} while (ch!='\n' && ch!=EOF);
00829   return(UNBOUND);}
00830 
00831 static pointer readrparen(ctx,f)
00832 { return(UNBOUND);}
00833 
00834 
00835 
00836 int gcd(u,v)
00837 register int u,v;
00838 { register int t;
00839   if(u<0) u = -u;
00840   if(v<0) v = -v;
00841   if(u<v) {t=u; u=v; v=t;}
00842   while(v!=0){t=u % v; u=v; v=t;}
00843   return(u);}
00844 
00845 static pointer readratio(ctx,token,slash)
00846 context *ctx;
00847 char *token;
00848 int slash;
00849 { int num, denom, g;
00850   extern pointer makeratio();
00851   num=strtol(token,NULL,intval(Spevalof(READBASE)));
00852   denom=strtol(&token[slash+1],NULL,intval(Spevalof(READBASE)));
00853   g=gcd(num, denom);
00854   if (g!=0) { num /= g; denom /= g;}
00855   else return(makeint(0));
00856   if (denom==1) return(makeint(num));
00857   return(makeratio(num, denom));}
00858 
00859 
00860 static pointer read2(ctx,ins,escaped,multiescaped,i,token,colon)
00861 register context *ctx;
00862 register pointer ins;
00863 int escaped,multiescaped,i;
00864 char token[];
00865 int colon;
00866 { register int j,c;
00867   register eusinteger_t base;
00868   int slash;
00869   enum ch_type ctype;
00870   /*Char ch;*/
00871   int ch;
00872   pointer readcase; 
00873   numunion nu;
00874   extern double atof();
00875   
00876   readcase=Spevalof(QREADTABLE)->c.rdtab.readcase;
00877 
00878   if (multiescaped) goto step9;
00879  step8:
00880     if (i>=MAXTOKENLENGTH) error(E_LONGSTRING);
00881     ch=readch(ins);
00882     if (ch==EOF) goto step10;
00883     if (ch<0) ch &= 0xff;
00884     ctype=syntaxtype(ch);
00885     switch(ctype) {
00886       case ch_constituent: case ch_nontermacro:
00887         if (charattr[ch]==package_marker) colon=i;
00888         if (readcase==K_DOWNCASE) ch=to_lower(ch);
00889         else if (readcase==K_PRESERVE) ch=ch;
00890         else  ch=to_upper(ch);
00891         token[i++]=ch; goto step8;
00892       case ch_sglescape:
00893         token[i++]=readch(ins); escaped=1; goto step8;
00894       case ch_multiescape:
00895         goto step9;
00896       case ch_illegal:
00897         error(E_ILLCH,makeint(ch)); break;
00898       case ch_termmacro:
00899         unreadch(ins,ch); goto step10;
00900       case ch_white:
00901         unreadch(ins,ch); goto step10;
00902       default: error(E_USER,(pointer)"unknown char type");}
00903  step9:
00904     escaped=1;
00905     if (i>=MAXTOKENLENGTH) error(E_LONGSTRING);
00906     ch=readch(ins);
00907     if (ch==EOF) error(E_EOF);
00908     ch &= 0xff;
00909     ctype=syntaxtype(ch);
00910     switch(ctype) {
00911       case ch_constituent: case ch_white:
00912       case ch_nontermacro: case ch_termmacro:
00913         token[i++]=ch; goto step9;
00914       case ch_sglescape:
00915         ch=readch(ins); token[i++]=ch; goto step9;
00916       case ch_multiescape:
00917         goto step8;
00918       default: error(E_ILLCH,makeint(ch));}
00919  step10:
00920     /*token is accumulated; analyze syntax*/
00921     token[i]=0;
00922     if (escaped) return(readsymbol(ctx,i,colon,token));
00923     base=intval(Spevalof(READBASE));
00924 
00925     j=0;
00926     if ((token[j]=='+') || (token[j]=='-')) j++;
00927     else if (token[j]=='.' && token[j+1]=='\0')
00928       return(readsymbol(ctx,i,colon,token));
00929     if (is_digit(token[j],base) || token[j]=='.') {
00930       while (is_digit(token[j],base)) j++;
00931       if (token[j] == '.') {    /*float?*/
00932         if (++j==i) return(readint(ctx,token,i));
00933         /*float or symbol*/
00934         while (is_digit(token[j],base)) j++;
00935         c=to_upper(token[j]);
00936         if (c=='E' || c=='D' || c=='F' || c=='L') {
00937           c=j;  j++;
00938           if ((token[j]=='+') || (token[j]=='-')) j++;
00939           while (is_digit(token[j],base)) j++;
00940           if (j==i) { token[c]='E'; return(makeflt(atof(token)));}
00941           else return(readsymbol(ctx,i,colon,token));}
00942         else if (j==i) return(makeflt(atof(token)));
00943         else return(readsymbol(ctx,i,colon,token));}
00944       else if (token[j] == '/') {  /* ratio? */
00945         slash=j;
00946         if (++j==i) return(readsymbol(ctx,i,colon,token));
00947         /*ratio or symbol*/
00948         while (is_digit(token[j],base)) j++;
00949         if (j==i) return(readratio(ctx,token,slash));
00950         else return(readsymbol(ctx,i,colon,token));}
00951       else if (j==i) return(readint(ctx,token,i));
00952       else {
00953         c=to_upper(token[j]);
00954         if (c=='E' || c=='D' || c=='F' || c=='L') {
00955           c=j;  j++;
00956           if ((token[j]=='+') || (token[j]=='-')) j++;
00957           while (is_digit(token[j],base)) j++;
00958           if (j==i) {/*all digits*/ token[c]='E'; return(makeflt(atof(token)));}
00959           else return(readsymbol(ctx,i,colon,token));}
00960         else if (j==i) return(makeflt(atof(token)));
00961         else return(readsymbol(ctx,i,colon,token));} }
00962     else return(readsymbol(ctx,i,colon,token));}
00963 
00964 static pointer read1(ctx,ins)
00965 register context *ctx;
00966 register pointer ins;
00967 { register enum ch_type ctype;
00968   register int firstch;
00969   register pointer macrofunc,result;
00970   pointer (*intmac)();
00971   int colon;
00972 /*  Char ch; */
00973   int ch;
00974   char token[MAXTOKENLENGTH];
00975   pointer readcase;
00976 
00977   colon= -1;
00978   step1:
00979     ch=readch(ins);
00980     if (ch==EOF) return((pointer)EOF);
00981     ch &= 0xff;
00982     firstch=ch;
00983     ctype=syntaxtype(ch);
00984     switch(ctype) {
00985       case ch_illegal: error(E_ILLCH,makeint(ch));
00986       case ch_white: goto step1;
00987       case ch_termmacro: case ch_nontermacro:
00988               macrofunc=Spevalof(QREADTABLE)->c.rdtab.macro->c.vec.v[ch];
00989               if (macrofunc==NIL) error(E_USER,(pointer)"no char macro defined");
00990               if (isint(macrofunc)) {   /*internal macro*/
00991                 intmac=(pointer (*)())(intval(macrofunc));
00992                 result=(*intmac)(ctx,ins,ch,token);}
00993               else {
00994                 vpush(ins); vpush(makeint(ch));
00995                 result=ufuncall(ctx,macrofunc,macrofunc,(pointer)(ctx->vsp-2),NULL,2);
00996                 ctx->vsp-=2;}
00997 /*            if (result==UNBOUND && firstch!=')') goto step1;
00998               else return(result);*/
00999               return(result);
01000       case ch_sglescape: token[0]=readch(ins);
01001                          return(read2(ctx,ins,1,0,1,token,colon));
01002       case ch_multiescape: return(read2(ctx,ins,1,1,0,token,colon));
01003       case ch_constituent:
01004               if (charattr[ch]==package_marker) colon=0;
01005               readcase=Spevalof(QREADTABLE)->c.rdtab.readcase;
01006               if (readcase==K_DOWNCASE) ch=to_lower(ch);
01007               else if (readcase==K_PRESERVE) ch=ch;
01008               else  ch=to_upper(ch);
01009               token[0]= ch;
01010               return(read2(ctx,ins,0,0,1,token,colon));}}
01011 
01012 pointer reader(ctx,f,recursivep)
01013 register context *ctx;
01014 register pointer f,recursivep;
01015 { register pointer val;
01016   Char ch;
01017   current_syntax[thr_self()]=Spevalof(QREADTABLE)->c.rdtab.syntax->c.str.chars;
01018   ch=nextch(ctx,f);
01019   if (ch==EOF) return((pointer)EOF);
01020   while (ch==')') ch=nextch(ctx,f);
01021   unreadch(f,ch);
01022   if (recursivep==NIL) {
01023     pointer_update(oblabels[thr_self()]->c.lab.next,NIL);
01024     val=read1(ctx,f);
01025     pointer_update(oblabels[thr_self()]->c.lab.next,NIL);}
01026   else val=read1(ctx,f);        /*if called recursively, keep #n= scope*/
01027   if (val==UNBOUND) return(NIL);
01028   return(val);}
01029 
01030 void initreader(ctx)
01031 register context *ctx;
01032 { register pointer rdtable;
01033   register int i;
01034 
01035   charmacro['(']=makeint((eusinteger_t)readlist);
01036   charmacro[')']=makeint((eusinteger_t)readrparen);
01037   charmacro['#']=makeint((eusinteger_t)readsharp);
01038   charmacro['\'']=makeint((eusinteger_t)readquote);
01039   charmacro['"']=makeint((eusinteger_t)readstring);
01040   charmacro[';']=makeint((eusinteger_t)readcomment);
01041 
01042   sharpmacro['\\']=makeint((eusinteger_t)read_sharp_char);
01043   sharpmacro['\'']=makeint((eusinteger_t)read_sharp_function);
01044   sharpmacro[':']=makeint((eusinteger_t)read_uninterned_symbol);
01045   sharpmacro[',']=makeint((eusinteger_t)read_sharp_eval);
01046   sharpmacro['.']=makeint((eusinteger_t)read_sharp_eval);
01047   sharpmacro['|']=makeint((eusinteger_t)read_sharp_comment);
01048   sharpmacro['+']=makeint((eusinteger_t)read_cond_plus);
01049   sharpmacro['-']=makeint((eusinteger_t)read_cond_minus);
01050   sharpmacro['#']=makeint((eusinteger_t)readlabref);
01051   sharpmacro['=']=makeint((eusinteger_t)readlabdef);
01052   sharpmacro['(']=makeint((eusinteger_t)readvector);
01053   sharpmacro['<']=makeint((eusinteger_t)read_sharp_object);
01054   sharpmacro['X']=makeint((eusinteger_t)read_sharp_hex);
01055   sharpmacro['O']=makeint((eusinteger_t)read_sharp_octal);
01056   sharpmacro['S']=makeint((eusinteger_t)readstructure);
01057   sharpmacro['F']=makeint((eusinteger_t)readfvector);
01058   sharpmacro['I']=makeint((eusinteger_t)readivector);
01059   sharpmacro['J']=makeint((eusinteger_t)readobject);
01060   sharpmacro['V']=makeint((eusinteger_t)readobject);
01061 
01062   /* make default readtable */
01063   rdtable=(pointer)makereadtable(ctx);
01064   pointer_update(Spevalof(QREADTABLE),rdtable);
01065   for (i=0; i<256; i++) {
01066     rdtable->c.rdtab.syntax->c.str.chars[i]=(int)chartype[i];
01067     rdtable->c.rdtab.macro->c.vec.v[i]=charmacro[i];
01068     rdtable->c.rdtab.dispatch->c.vec.v[i]=sharpmacro[i];
01069     rdtable->c.rdtab.readcase=K_UPCASE;
01070     }
01071   }


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Mar 9 2017 04:57:50