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