![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lex.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / f77|
Return to lex.c CVS log | Up to [Research Unix] / researchv10no / cmd / f77 |
1.1 root 1: #include "defs"
2: #include "tokdefs"
3:
4: # define BLANK ' '
5: # define MYQUOTE (2)
6: # define SEOF 0
7:
8: /* card types */
9:
10: # define STEOF 1
11: # define STINITIAL 2
12: # define STCONTINUE 3
13:
14: /* lex states */
15:
16: #define NEWSTMT 1
17: #define FIRSTTOKEN 2
18: #define OTHERTOKEN 3
19: #define RETEOS 4
20:
21:
22: LOCAL int stkey;
23: LOCAL int lastend = 1;
24: ftnint yystno;
25: flag intonly;
26: LOCAL long int stno;
27: LOCAL long int nxtstno;
28: LOCAL int parlev;
29: LOCAL int expcom;
30: LOCAL int expeql;
31: LOCAL char *nextch;
32: LOCAL char *lastch;
33: LOCAL char *nextcd = NULL;
34: LOCAL char *endcd;
35: LOCAL int prevlin;
36: LOCAL int thislin;
37: LOCAL int code;
38: LOCAL int lexstate = NEWSTMT;
39: LOCAL char s[1390];
40: LOCAL char *send = s+20*66;
41: LOCAL int nincl = 0;
42: LOCAL int getcds(), getcd(), crunch(), analyz(), getkwd(), gettok();
43:
44: struct Inclfile
45: {
46: struct Inclfile *inclnext;
47: FILEP inclfp;
48: char *inclname;
49: int incllno;
50: char *incllinp;
51: int incllen;
52: int inclcode;
53: ftnint inclstno;
54: };
55:
56: LOCAL struct Inclfile *inclp = NULL;
57: LOCAL struct Keylist {
58: char *keyname;
59: int keyval;
60: char notinf66;
61: };
62: LOCAL struct Punctlist {
63: char punchar;
64: int punval;
65: };
66: LOCAL struct Fmtlist {
67: char fmtchar;
68: int fmtval;
69: };
70: LOCAL struct Dotlist {
71: char *dotname;
72: int dotval;
73: };
74: LOCAL struct Keylist *keystart[26], *keyend[26];
75:
76:
77:
78:
79: inilex(name)
80: char *name;
81: {
82: nincl = 0;
83: inclp = NULL;
84: doinclude(name);
85: lexstate = NEWSTMT;
86: return(NO);
87: }
88:
89:
90:
91: /* throw away the rest of the current line */
92: flline()
93: {
94: lexstate = RETEOS;
95: }
96:
97:
98:
99: char *lexline(n)
100: int *n;
101: {
102: *n = (lastch - nextch) + 1;
103: return(nextch);
104: }
105:
106:
107:
108:
109:
110: doinclude(name)
111: char *name;
112: {
113: FILEP fp;
114: struct Inclfile *t;
115: char temp[100];
116: register char *lastslash, *s;
117:
118: if(inclp)
119: {
120: inclp->incllno = thislin;
121: inclp->inclcode = code;
122: inclp->inclstno = nxtstno;
123: if(nextcd)
124: inclp->incllinp = copyn(inclp->incllen = endcd-nextcd , nextcd);
125: else
126: inclp->incllinp = 0;
127: }
128: nextcd = NULL;
129:
130: if(++nincl >= MAXINCLUDES)
131: fatal("includes nested too deep");
132: if(name[0] == '\0')
133: fp = stdin;
134: else if(name[0]=='/' || inclp==NULL)
135: fp = fopen(name, "r");
136: else {
137: lastslash = NULL;
138: for(s = inclp->inclname ; *s ; ++s)
139: if(*s == '/')
140: lastslash = s;
141: if(lastslash)
142: {
143: *lastslash = '\0';
144: sprintf(temp, "%s/%s", inclp->inclname, name);
145: *lastslash = '/';
146: }
147: else
148: strcpy(temp, name);
149:
150: if( (fp = fopen(temp, "r")) == NULL )
151: {
152: sprintf(temp, "/usr/include/%s", name);
153: fp = fopen(temp, "r");
154: }
155: if(fp)
156: name = copys(temp);
157: }
158:
159: if( fp )
160: {
161: t = inclp;
162: inclp = ALLOC(Inclfile);
163: inclp->inclnext = t;
164: prevlin = thislin = 0;
165: infname = inclp->inclname = name;
166: infile = inclp->inclfp = fp;
167: }
168: else
169: {
170: fprintf(diagfile, "Cannot open file %s", name);
171: done(1);
172: }
173: }
174:
175:
176:
177:
178: LOCAL popinclude()
179: {
180: struct Inclfile *t;
181: register char *p;
182: register int k;
183:
184: if(infile != stdin)
185: clf(&infile);
186: free(infname);
187:
188: --nincl;
189: t = inclp->inclnext;
190: free( (charptr) inclp);
191: inclp = t;
192: if(inclp == NULL)
193: return(NO);
194:
195: infile = inclp->inclfp;
196: infname = inclp->inclname;
197: prevlin = thislin = inclp->incllno;
198: code = inclp->inclcode;
199: stno = nxtstno = inclp->inclstno;
200: if(inclp->incllinp)
201: {
202: endcd = nextcd = s;
203: k = inclp->incllen;
204: p = inclp->incllinp;
205: while(--k >= 0)
206: *endcd++ = *p++;
207: free( (charptr) (inclp->incllinp) );
208: }
209: else
210: nextcd = NULL;
211: return(YES);
212: }
213:
214:
215:
216:
217: yylex()
218: {
219: static int tokno;
220:
221: switch(lexstate)
222: {
223: case NEWSTMT : /* need a new statement */
224: if(getcds() == STEOF)
225: return(SEOF);
226: lastend = stkey == SEND;
227: crunch();
228: tokno = 0;
229: lexstate = FIRSTTOKEN;
230: yystno = stno;
231: stno = nxtstno;
232: toklen = 0;
233: return(SLABEL);
234:
235: first:
236: case FIRSTTOKEN : /* first step on a statement */
237: analyz();
238: lexstate = OTHERTOKEN;
239: tokno = 1;
240: return(stkey);
241:
242: case OTHERTOKEN : /* return next token */
243: if(nextch > lastch)
244: goto reteos;
245: ++tokno;
246: if( (stkey==SLOGIF || stkey==SELSEIF) && parlev==0 && tokno>3)
247: goto first;
248:
249: if(stkey==SASSIGN && tokno==3 && nextch<lastch &&
250: nextch[0]=='t' && nextch[1]=='o')
251: {
252: nextch+=2;
253: return(STO);
254: }
255: return(gettok());
256:
257: reteos:
258: case RETEOS:
259: lexstate = NEWSTMT;
260: return(SEOS);
261: }
262: fatali("impossible lexstate %d", lexstate);
263: /* NOTREACHED */
264: }
265:
266: LOCAL getcds()
267: {
268: register char *p, *q;
269:
270: top:
271: if(nextcd == NULL)
272: {
273: code = getcd( nextcd = s );
274: stno = nxtstno;
275: prevlin = thislin;
276: }
277: if(code == STEOF)
278: if( popinclude() )
279: goto top;
280: else
281: return(STEOF);
282:
283: if(code == STCONTINUE)
284: {
285: lineno = thislin;
286: err("illegal continuation card ignored");
287: nextcd = NULL;
288: goto top;
289: }
290:
291: if(nextcd > s)
292: {
293: q = nextcd;
294: p = s;
295: while(q < endcd)
296: *p++ = *q++;
297: endcd = p;
298: }
299: for(nextcd = endcd ;
300: nextcd+66<=send && (code = getcd(nextcd))==STCONTINUE ;
301: nextcd = endcd )
302: ;
303: nextch = s;
304: lastch = nextcd - 1;
305: if(nextcd >= send)
306: nextcd = NULL;
307: lineno = prevlin;
308: prevlin = thislin;
309: return(STINITIAL);
310: }
311:
312: LOCAL getcd(b)
313: register char *b;
314: {
315: register int c;
316: register char *p, *bend;
317: int speclin;
318: static char a[6];
319: static char *aend = a+6;
320:
321: top:
322: endcd = b;
323: bend = b+66;
324: speclin = NO;
325:
326: if( (c = getc(infile)) == '&')
327: {
328: a[0] = BLANK;
329: a[5] = 'x';
330: speclin = YES;
331: bend = send;
332: }
333: else if(c=='c' || c=='C' || c=='*')
334: {
335: while( (c = getc(infile)) != '\n')
336: if(c == EOF)
337: return(STEOF);
338: ++thislin;
339: goto top;
340: }
341:
342: else if(c != EOF)
343: {
344: /* a tab in columns 1-6 skips to column 7 */
345: ungetc(c, infile);
346: for(p=a; p<aend && (c=getc(infile)) != '\n' && c!=EOF; )
347: if(c == '\t')
348: {
349: while(p < aend)
350: *p++ = BLANK;
351: speclin = YES;
352: bend = send;
353: }
354: else
355: *p++ = c;
356: }
357: if(c == EOF)
358: return(STEOF);
359: if(c == '\n')
360: {
361: while(p < aend)
362: *p++ = BLANK;
363: if( ! speclin )
364: while(endcd < bend)
365: *endcd++ = BLANK;
366: }
367: else { /* read body of line */
368: while( endcd<bend && (c=getc(infile)) != '\n' && c!=EOF )
369: *endcd++ = c;
370: if(c == EOF)
371: return(STEOF);
372: if(c != '\n')
373: {
374: while( (c=getc(infile)) != '\n')
375: if(c == EOF)
376: return(STEOF);
377: }
378:
379: if( ! speclin )
380: while(endcd < bend)
381: *endcd++ = BLANK;
382: }
383: ++thislin;
384: if( !isspace(a[5]) && a[5]!='0')
385: return(STCONTINUE);
386: for(p=a; p<aend; ++p)
387: if( !isspace(*p) ) goto initline;
388: for(p = b ; p<endcd ; ++p)
389: if( !isspace(*p) ) goto initline;
390: goto top;
391:
392: initline:
393: nxtstno = 0;
394: for(p = a ; p<a+5 ; ++p)
395: if( !isspace(*p) )
396: if(isdigit(*p))
397: nxtstno = 10*nxtstno + (*p - '0');
398: else {
399: lineno = thislin;
400: err("nondigit in statement number field");
401: nxtstno = 0;
402: break;
403: }
404: return(STINITIAL);
405: }
406:
407: LOCAL crunch()
408: {
409: register char *i, *j, *j0, *j1, *prvstr;
410: int ten, nh, quote;
411:
412: /* i is the next input character to be looked at
413: j is the next output character */
414: parlev = 0;
415: expcom = 0; /* exposed ','s */
416: expeql = 0; /* exposed equal signs */
417: j = s;
418: prvstr = s;
419: for(i=s ; i<=lastch ; ++i)
420: {
421: if(isspace(*i) )
422: continue;
423: if(*i=='\'' || *i=='"')
424: {
425: quote = *i;
426: *j = MYQUOTE; /* special marker */
427: for(;;)
428: {
429: if(++i > lastch)
430: {
431: err("unbalanced quotes; closing quote supplied");
432: break;
433: }
434: if(*i == quote)
435: if(i<lastch && i[1]==quote) ++i;
436: else break;
437: else if(*i=='\\' && i<lastch)
438: switch(*++i)
439: {
440: case 't':
441: *i = '\t';
442: break;
443: case 'b':
444: *i = '\b';
445: break;
446: case 'n':
447: *i = '\n';
448: break;
449: case 'f':
450: *i = '\f';
451: break;
452: case 'v':
453: *i = '\v';
454: break;
455: case '0':
456: *i = '\0';
457: break;
458: default:
459: break;
460: }
461: *++j = *i;
462: }
463: j[1] = MYQUOTE;
464: j += 2;
465: prvstr = j;
466: }
467: else if( (*i=='h' || *i=='H') && j>prvstr) /* test for Hollerith strings */
468: {
469: if( ! isdigit(j[-1])) goto copychar;
470: nh = j[-1] - '0';
471: ten = 10;
472: j1 = prvstr - 1;
473: if (j1<j-5) j1=j-5;
474: for(j0=j-2 ; j0>j1; -- j0)
475: {
476: if( ! isdigit(*j0 ) ) break;
477: nh += ten * (*j0-'0');
478: ten*=10;
479: }
480: if(j0 <= j1) goto copychar;
481: /* a hollerith must be preceded by a punctuation mark.
482: '*' is possible only as repetition factor in a data statement
483: not, in particular, in character*2h
484: */
485:
486: if( !(*j0=='*'&&s[0]=='d') && *j0!='/' && *j0!='(' &&
487: *j0!=',' && *j0!='=' && *j0!='.')
488: goto copychar;
489: if(i+nh > lastch)
490: {
491: erri("%dH too big", nh);
492: nh = lastch - i;
493: }
494: j0[1] = MYQUOTE; /* special marker */
495: j = j0 + 1;
496: while(nh-- > 0)
497: {
498: if(*++i == '\\')
499: switch(*++i)
500: {
501: case 't':
502: *i = '\t';
503: break;
504: case 'b':
505: *i = '\b';
506: break;
507: case 'n':
508: *i = '\n';
509: break;
510: case 'f':
511: *i = '\f';
512: break;
513: case '0':
514: *i = '\0';
515: break;
516: default:
517: break;
518: }
519: *++j = *i;
520: }
521: j[1] = MYQUOTE;
522: j+=2;
523: prvstr = j;
524: }
525: else {
526: if(*i == '(') ++parlev;
527: else if(*i == ')') --parlev;
528: else if(parlev == 0)
529: if(*i == '=') expeql = 1;
530: else if(*i == ',') expcom = 1;
531: copychar: /*not a string or space -- copy, shifting case if necessary */
532: if(shiftcase && isupper(*i))
533: *j++ = tolower(*i);
534: else *j++ = *i;
535: }
536: }
537: lastch = j - 1;
538: nextch = s;
539: }
540:
541: LOCAL analyz()
542: {
543: register char *i;
544:
545: if(parlev != 0)
546: {
547: err("unbalanced parentheses, statement skipped");
548: stkey = SUNKNOWN;
549: return;
550: }
551: if(nextch+2<=lastch && nextch[0]=='i' && nextch[1]=='f' && nextch[2]=='(')
552: {
553: /* assignment or if statement -- look at character after balancing paren */
554: parlev = 1;
555: for(i=nextch+3 ; i<=lastch; ++i)
556: if(*i == (MYQUOTE))
557: {
558: while(*++i != MYQUOTE)
559: ;
560: }
561: else if(*i == '(')
562: ++parlev;
563: else if(*i == ')')
564: {
565: if(--parlev == 0)
566: break;
567: }
568: if(i >= lastch)
569: stkey = SLOGIF;
570: else if(i[1] == '=')
571: stkey = SLET;
572: else if( isdigit(i[1]) )
573: stkey = SARITHIF;
574: else stkey = SLOGIF;
575: if(stkey != SLET)
576: nextch += 2;
577: }
578: else if(expeql) /* may be an assignment */
579: {
580: if(expcom && nextch<lastch &&
581: nextch[0]=='d' && nextch[1]=='o')
582: {
583: stkey = SDO;
584: nextch += 2;
585: }
586: else stkey = SLET;
587: }
588: /* otherwise search for keyword */
589: else {
590: stkey = getkwd();
591: if(stkey==SGOTO && lastch>=nextch)
592: if(nextch[0]=='(')
593: stkey = SCOMPGOTO;
594: else if(isalpha(nextch[0]))
595: stkey = SASGOTO;
596: }
597: parlev = 0;
598: }
599:
600:
601:
602: LOCAL getkwd()
603: {
604: register char *i, *j;
605: register struct Keylist *pk, *pend;
606: int k;
607:
608: if(! isalpha(nextch[0]) )
609: return(SUNKNOWN);
610: k = nextch[0] - 'a';
611: if(pk = keystart[k])
612: for(pend = keyend[k] ; pk<=pend ; ++pk )
613: {
614: i = pk->keyname;
615: j = nextch;
616: while(*++i==*++j && *i!='\0')
617: ;
618: if(*i=='\0' && j<=lastch+1)
619: {
620: nextch = j;
621: if(no66flag && pk->notinf66)
622: errstr("Not a Fortran 66 keyword: %s",
623: pk->keyname);
624: return(pk->keyval);
625: }
626: }
627: return(SUNKNOWN);
628: }
629:
630:
631:
632: LOCAL struct Dotlist dots[ ] =
633: {
634: "and.", SAND,
635: "or.", SOR,
636: "not.", SNOT,
637: "true.", STRUE,
638: "false.", SFALSE,
639: "eq.", SEQ,
640: "ne.", SNE,
641: "lt.", SLT,
642: "le.", SLE,
643: "gt.", SGT,
644: "ge.", SGE,
645: "neqv.", SNEQV,
646: "eqv.", SEQV,
647: 0, 0 };
648:
649: LOCAL struct Keylist keys[ ] =
650: {
651: { "assign", SASSIGN },
652: { "automatic", SAUTOMATIC, YES },
653: { "backspace", SBACKSPACE },
654: { "blockdata", SBLOCK },
655: { "call", SCALL },
656: { "character", SCHARACTER, YES },
657: { "close", SCLOSE, YES },
658: { "common", SCOMMON },
659: { "complex", SCOMPLEX },
660: { "continue", SCONTINUE },
661: { "data", SDATA },
662: { "dimension", SDIMENSION },
663: { "doubleprecision", SDOUBLE },
664: { "doublecomplex", SDCOMPLEX, YES },
665: { "elseif", SELSEIF, YES },
666: { "else", SELSE, YES },
667: { "endfile", SENDFILE },
668: { "endif", SENDIF, YES },
669: { "end", SEND },
670: { "entry", SENTRY, YES },
671: { "equivalence", SEQUIV },
672: { "external", SEXTERNAL },
673: { "format", SFORMAT },
674: { "function", SFUNCTION },
675: { "goto", SGOTO },
676: { "implicit", SIMPLICIT, YES },
677: { "include", SINCLUDE, YES },
678: { "inquire", SINQUIRE, YES },
679: { "intrinsic", SINTRINSIC, YES },
680: { "integer", SINTEGER },
681: { "logical", SLOGICAL },
682: { "namelist", SNAMELIST, YES },
683: { "none", SUNDEFINED, YES },
684: { "open", SOPEN, YES },
685: { "parameter", SPARAM, YES },
686: { "pause", SPAUSE },
687: { "print", SPRINT },
688: { "program", SPROGRAM, YES },
689: { "punch", SPUNCH, YES },
690: { "read", SREAD },
691: { "real", SREAL },
692: { "return", SRETURN },
693: { "rewind", SREWIND },
694: { "save", SSAVE, YES },
695: { "static", SSTATIC, YES },
696: { "stop", SSTOP },
697: { "subroutine", SSUBROUTINE },
698: { "then", STHEN, YES },
699: { "undefined", SUNDEFINED, YES },
700: { "write", SWRITE },
701: { 0, 0 }
702: };
703:
704:
705: initkey()
706: {
707: register struct Keylist *p;
708: register int i,j;
709:
710: for(i = 0 ; i<26 ; ++i)
711: keystart[i] = NULL;
712:
713: for(p = keys ; p->keyname ; ++p)
714: {
715: j = p->keyname[0] - 'a';
716: if(keystart[j] == NULL)
717: keystart[j] = p;
718: keyend[j] = p;
719: }
720: }
721:
722: LOCAL gettok()
723: {
724: int havdot, havexp, havdbl;
725: int radix, val;
726: extern struct Punctlist puncts[];
727: struct Punctlist *pp;
728: extern struct Fmtlist fmts[];
729: struct Dotlist *pd;
730:
731: char *i, *j, *n1, *p;
732:
733: if(*nextch == (MYQUOTE))
734: {
735: ++nextch;
736: p = token;
737: while(*nextch != MYQUOTE)
738: *p++ = *nextch++;
739: ++nextch;
740: toklen = p - token;
741: *p = '\0';
742: return (SHOLLERITH);
743: }
744: /*
745: if(stkey == SFORMAT)
746: {
747: for(pf = fmts; pf->fmtchar; ++pf)
748: {
749: if(*nextch == pf->fmtchar)
750: {
751: ++nextch;
752: if(pf->fmtval == SLPAR)
753: ++parlev;
754: else if(pf->fmtval == SRPAR)
755: --parlev;
756: return(pf->fmtval);
757: }
758: }
759: if( isdigit(*nextch) )
760: {
761: p = token;
762: *p++ = *nextch++;
763: while(nextch<=lastch && isdigit(*nextch) )
764: *p++ = *nextch++;
765: toklen = p - token;
766: *p = '\0';
767: if(nextch<=lastch && *nextch=='p')
768: {
769: ++nextch;
770: return(SSCALE);
771: }
772: else return(SICON);
773: }
774: if( isalpha(*nextch) )
775: {
776: p = token;
777: *p++ = *nextch++;
778: while(nextch<=lastch &&
779: (*nextch=='.' || isdigit(*nextch) || isalpha(*nextch) ))
780: *p++ = *nextch++;
781: toklen = p - token;
782: *p = '\0';
783: return(SFIELD);
784: }
785: goto badchar;
786: }
787: /* Not a format statement */
788:
789: if(needkwd)
790: {
791: needkwd = 0;
792: return( getkwd() );
793: }
794:
795: for(pp=puncts; pp->punchar; ++pp)
796: if(*nextch == pp->punchar)
797: {
798: if( (*nextch=='*' || *nextch=='/') &&
799: nextch<lastch && nextch[1]==nextch[0])
800: {
801: if(*nextch == '*')
802: val = SPOWER;
803: else val = SCONCAT;
804: nextch+=2;
805: }
806: else {
807: val = pp->punval;
808: if(val==SLPAR)
809: ++parlev;
810: else if(val==SRPAR)
811: --parlev;
812: ++nextch;
813: }
814: return(val);
815: }
816: if(*nextch == '.')
817: if(nextch >= lastch) goto badchar;
818: else if(isdigit(nextch[1])) goto numconst;
819: else {
820: for(pd=dots ; (j=pd->dotname) ; ++pd)
821: {
822: for(i=nextch+1 ; i<=lastch ; ++i)
823: if(*i != *j) break;
824: else if(*i != '.') ++j;
825: else {
826: nextch = i+1;
827: return(pd->dotval);
828: }
829: }
830: goto badchar;
831: }
832: if( isalpha(*nextch) )
833: {
834: p = token;
835: *p++ = *nextch++;
836: while(nextch<=lastch)
837: if( isalpha(*nextch) || isdigit(*nextch) )
838: *p++ = *nextch++;
839: else break;
840: toklen = p - token;
841: *p = '\0';
842: if(inioctl && nextch<=lastch && *nextch=='=')
843: {
844: ++nextch;
845: return(SNAMEEQ);
846: }
847: if(toklen>8 && eqn(8,token,"function") && isalpha(token[8]) &&
848: nextch<lastch && nextch[0]=='(' &&
849: (nextch[1]==')' | isalpha(nextch[1])) )
850: {
851: nextch -= (toklen - 8);
852: return(SFUNCTION);
853: }
854: if(toklen > VL)
855: {
856: char buff[30];
857: sprintf(buff, "name %s too long, truncated to %d",
858: token, VL);
859: err(buff);
860: toklen = VL;
861: token[VL] = '\0';
862: }
863: if(toklen==1 && *nextch==MYQUOTE)
864: {
865: switch(token[0])
866: {
867: case 'z':
868: case 'Z':
869: case 'x':
870: case 'X':
871: radix = 16;
872: break;
873: case 'o':
874: case 'O':
875: radix = 8;
876: break;
877: case 'b':
878: case 'B':
879: radix = 2;
880: break;
881: default:
882: err("bad bit identifier");
883: return(SNAME);
884: }
885: ++nextch;
886: for(p = token ; *nextch!=MYQUOTE ; )
887: if( hextoi(*p++ = *nextch++) >= radix)
888: {
889: err("invalid binary character");
890: break;
891: }
892: ++nextch;
893: toklen = p - token;
894: return( radix==16 ? SHEXCON :
895: (radix==8 ? SOCTCON : SBITCON) );
896: }
897: return(SNAME);
898: }
899: if( ! isdigit(*nextch) ) goto badchar;
900: numconst:
901: havdot = NO;
902: havexp = NO;
903: havdbl = NO;
904: for(n1 = nextch ; nextch<=lastch ; ++nextch)
905: {
906: if(*nextch == '.')
907: if(havdot) break;
908: else if(nextch+2<=lastch && isalpha(nextch[1])
909: && isalpha(nextch[2]))
910: break;
911: else havdot = YES;
912: else if( !intonly && (*nextch=='d' || *nextch=='e') )
913: {
914: p = nextch;
915: havexp = YES;
916: if(*nextch == 'd')
917: havdbl = YES;
918: if(nextch<lastch)
919: if(nextch[1]=='+' || nextch[1]=='-')
920: ++nextch;
921: if( ! isdigit(*++nextch) )
922: {
923: nextch = p;
924: havdbl = havexp = NO;
925: break;
926: }
927: for(++nextch ;
928: nextch<=lastch && isdigit(*nextch);
929: ++nextch);
930: break;
931: }
932: else if( ! isdigit(*nextch) )
933: break;
934: }
935: p = token;
936: i = n1;
937: while(i < nextch)
938: *p++ = *i++;
939: toklen = p - token;
940: *p = '\0';
941: if(havdbl) return(SDCON);
942: if(havdot || havexp) return(SRCON);
943: return(SICON);
944: badchar:
945: s[0] = *nextch++;
946: return(SUNKNOWN);
947: }
948:
949: /* KEYWORD AND SPECIAL CHARACTER TABLES
950: */
951:
952: struct Punctlist puncts[ ] =
953: {
954: '(', SLPAR,
955: ')', SRPAR,
956: '=', SEQUALS,
957: ',', SCOMMA,
958: '+', SPLUS,
959: '-', SMINUS,
960: '*', SSTAR,
961: '/', SSLASH,
962: '$', SCURRENCY,
963: ':', SCOLON,
964: 0, 0 };
965:
966: /*
967: LOCAL struct Fmtlist fmts[ ] =
968: {
969: '(', SLPAR,
970: ')', SRPAR,
971: '/', SSLASH,
972: ',', SCOMMA,
973: '-', SMINUS,
974: ':', SCOLON,
975: 0, 0 } ;
976: */
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.