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