1 /* $Id: lex.c,v 1.12 2008/05/11 15:28:03 ragge Exp $ */
2 /*
3 * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 *
9 * Redistributions of source code and documentation must retain the above
10 * copyright notice, this list of conditions and the following disclaimer.
11 * Redistributions in binary form must reproduce the above copyright
12 * notice, this list of conditionsand the following disclaimer in the
13 * documentation and/or other materials provided with the distribution.
14 * All advertising materials mentioning features or use of this software
15 * must display the following acknowledgement:
16 * This product includes software developed or owned by Caldera
17 * International, Inc.
18 * Neither the name of Caldera International, Inc. nor the names of other
19 * contributors may be used to endorse or promote products derived from
20 * this software without specific prior written permission.
21 *
22 * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA
23 * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
24 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
25 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
26 * DISCLAIMED. IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE
27 * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
28 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
29 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
30 * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT,
31 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
32 * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 * POSSIBILITY OF SUCH DAMAGE.
34 */
35 #include "defines.h"
36 #include "defs.h"
37
38 #include "gram.h"
39
40 # define BLANK ' '
41 # define MYQUOTE (2)
42 # define SEOF 0
43
44 /* card types */
45
46 # define STEOF 1
47 # define STINITIAL 2
48 # define STCONTINUE 3
49
50 /* lex states */
51
52 #define NEWSTMT 1
53 #define FIRSTTOKEN 2
54 #define OTHERTOKEN 3
55 #define RETEOS 4
56
57
58 LOCAL int stkey;
59 LOCAL int stno;
60 LOCAL long int nxtstno;
61 LOCAL int parlev;
62 LOCAL int expcom;
63 LOCAL int expeql;
64 LOCAL char *nextch;
65 LOCAL char *lastch;
66 LOCAL char *nextcd = NULL;
67 LOCAL char *endcd;
68 LOCAL int prevlin;
69 LOCAL int thislin;
70 LOCAL int code;
71 LOCAL int lexstate = NEWSTMT;
72 LOCAL char s[1390];
73 LOCAL char *send = s+20*66;
74 LOCAL int nincl = 0;
75
76 struct inclfile
77 {
78 struct inclfile *inclnext;
79 FILEP inclfp;
80 char *inclname;
81 int incllno;
82 char *incllinp;
83 int incllen;
84 int inclcode;
85 ftnint inclstno;
86 } ;
87
88 LOCAL struct inclfile *inclp = NULL;
89 struct keylist { char *keyname; int keyval; } ;
90 struct punctlist { char punchar; int punval; };
91 struct fmtlist { char fmtchar; int fmtval; };
92 struct dotlist { char *dotname; int dotval; };
93 LOCAL struct dotlist dots[];
94 LOCAL struct keylist *keystart[26], *keyend[26];
95 LOCAL struct keylist keys[];
96
97 LOCAL int getcds(void);
98 LOCAL void crunch(void);
99 LOCAL void analyz(void);
100 LOCAL int gettok(void);
101 LOCAL int getcd(char *b);
102 LOCAL int getkwd(void);
103 LOCAL int popinclude(void);
104
105 /*
106 * called from main() to start parsing.
107 * name[0] may be \0 if stdin.
108 */
109 int
inilex(char * name)110 inilex(char *name)
111 {
112 nincl = 0;
113 inclp = NULL;
114 doinclude(name);
115 lexstate = NEWSTMT;
116 return(NO);
117 }
118
119
120
121 /* throw away the rest of the current line */
122 void
flline()123 flline()
124 {
125 lexstate = RETEOS;
126 }
127
128
129
lexline(n)130 char *lexline(n)
131 ftnint *n;
132 {
133 *n = (lastch - nextch) + 1;
134 return(nextch);
135 }
136
137
138
139
140 void
doinclude(char * name)141 doinclude(char *name)
142 {
143 FILEP fp;
144 struct inclfile *t;
145
146 if(inclp) {
147 inclp->incllno = thislin;
148 inclp->inclcode = code;
149 inclp->inclstno = nxtstno;
150 if(nextcd)
151 inclp->incllinp =
152 copyn(inclp->incllen = endcd-nextcd , nextcd);
153 else
154 inclp->incllinp = 0;
155 }
156 nextcd = NULL;
157
158 if(++nincl >= MAXINCLUDES)
159 fatal("includes nested too deep");
160 if(name[0] == '\0')
161 fp = stdin;
162 else
163 fp = fopen(name, "r");
164 if( fp ) {
165 t = inclp;
166 inclp = ALLOC(inclfile);
167 inclp->inclnext = t;
168 prevlin = thislin = 0;
169 infname = inclp->inclname = name;
170 infile = inclp->inclfp = fp;
171 } else {
172 fprintf(diagfile, "Cannot open file %s", name);
173 done(1);
174 }
175 }
176
177
178
179
180 LOCAL int
popinclude()181 popinclude()
182 {
183 struct inclfile *t;
184 register char *p;
185 register int k;
186
187 if(infile != stdin)
188 fclose(infile);
189 ckfree(infname);
190
191 --nincl;
192 t = inclp->inclnext;
193 ckfree(inclp);
194 inclp = t;
195 if(inclp == NULL)
196 return(NO);
197
198 infile = inclp->inclfp;
199 infname = inclp->inclname;
200 prevlin = thislin = inclp->incllno;
201 code = inclp->inclcode;
202 stno = nxtstno = inclp->inclstno;
203 if(inclp->incllinp) {
204 endcd = nextcd = s;
205 k = inclp->incllen;
206 p = inclp->incllinp;
207 while(--k >= 0)
208 *endcd++ = *p++;
209 ckfree(inclp->incllinp);
210 } else
211 nextcd = NULL;
212 return(YES);
213 }
214
215
216
217 int
yylex()218 yylex()
219 {
220 static int tokno;
221
222 switch(lexstate)
223 {
224 case NEWSTMT : /* need a new statement */
225 if(getcds() == STEOF)
226 return(SEOF);
227 crunch();
228 tokno = 0;
229 lexstate = FIRSTTOKEN;
230 yylval.num = 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) goto first;
247 if(stkey==SASSIGN && tokno==3 && nextch<lastch &&
248 nextch[0]=='t' && nextch[1]=='o')
249 {
250 nextch+=2;
251 return(STO);
252 }
253 return(gettok());
254
255 reteos:
256 case RETEOS:
257 lexstate = NEWSTMT;
258 return(SEOS);
259 }
260 fatal1("impossible lexstate %d", lexstate);
261 /* NOTREACHED */
262 return 0; /* XXX gcc */
263 }
264
265 LOCAL int
getcds()266 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 int
getcd(b)313 getcd(b)
314 register char *b;
315 {
316 register int c;
317 register char *p, *bend;
318 int speclin;
319 static char a[6];
320 static char *aend = a+6;
321
322 top:
323 endcd = b;
324 bend = b+66;
325 speclin = NO;
326
327 if( (c = getc(infile)) == '&')
328 {
329 a[0] = BLANK;
330 a[5] = 'x';
331 speclin = YES;
332 bend = send;
333 }
334 else if(c=='c' || c=='C' || c=='*')
335 {
336 while( (c = getc(infile)) != '\n')
337 if(c == EOF)
338 return(STEOF);
339 ++thislin;
340 goto top;
341 }
342
343 else if(c != EOF)
344 {
345 /* a tab in columns 1-6 skips to column 7 */
346 ungetc(c, infile);
347 for(p=a; p<aend && (c=getc(infile)) != '\n' && c!=EOF; )
348 if(c == '\t')
349 {
350 while(p < aend)
351 *p++ = BLANK;
352 speclin = YES;
353 bend = send;
354 }
355 else
356 *p++ = c;
357 }
358 if(c == EOF)
359 return(STEOF);
360 if(c == '\n')
361 {
362 p = a; /* XXX ??? */
363 while(p < aend)
364 *p++ = BLANK;
365 if( ! speclin )
366 while(endcd < bend)
367 *endcd++ = BLANK;
368 }
369 else { /* read body of line */
370 while( endcd<bend && (c=getc(infile)) != '\n' && c!=EOF )
371 *endcd++ = (c == '\t' ? BLANK : c);
372 if(c == EOF)
373 return(STEOF);
374 if(c != '\n')
375 {
376 while( (c=getc(infile)) != '\n')
377 if(c == EOF)
378 return(STEOF);
379 }
380
381 if( ! speclin )
382 while(endcd < bend)
383 *endcd++ = BLANK;
384 }
385 ++thislin;
386 if(a[5]!=BLANK && a[5]!='0')
387 return(STCONTINUE);
388 for(p=a; p<aend; ++p)
389 if(*p != BLANK) goto initline;
390 for(p = b ; p<endcd ; ++p)
391 if(*p != BLANK) goto initline;
392 goto top;
393
394 initline:
395 nxtstno = 0;
396 for(p = a ; p<a+5 ; ++p)
397 if(*p != BLANK) {
398 if(isdigit((int)*p))
399 nxtstno = 10*nxtstno + (*p - '0');
400 else {
401 lineno = thislin;
402 err("nondigit in statement number field");
403 nxtstno = 0;
404 break;
405 }
406 }
407 return(STINITIAL);
408 }
409
410 LOCAL void
crunch()411 crunch()
412 {
413 register char *i, *j, *j0, *j1, *prvstr;
414 int ten, nh, quote;
415
416 /* i is the next input character to be looked at
417 j is the next output character */
418 parlev = 0;
419 expcom = 0; /* exposed ','s */
420 expeql = 0; /* exposed equal signs */
421 j = s;
422 prvstr = s;
423 for(i=s ; i<=lastch ; ++i)
424 {
425 if(*i == BLANK) continue;
426 if(*i=='\'' || *i=='"')
427 {
428 quote = *i;
429 *j = MYQUOTE; /* special marker */
430 for(;;)
431 {
432 if(++i > lastch)
433 {
434 err("unbalanced quotes; closing quote supplied");
435 break;
436 }
437 if(*i == quote)
438 if(i<lastch && i[1]==quote) ++i;
439 else break;
440 else if(*i=='\\' && i<lastch)
441 switch(*++i)
442 {
443 case 't':
444 *i = '\t'; break;
445 case 'b':
446 *i = '\b'; break;
447 case 'n':
448 *i = '\n'; break;
449 case 'f':
450 *i = '\f'; break;
451 case '0':
452 *i = '\0'; break;
453 default:
454 break;
455 }
456 *++j = *i;
457 }
458 j[1] = MYQUOTE;
459 j += 2;
460 prvstr = j;
461 }
462 else if( (*i=='h' || *i=='H') && j>prvstr) /* test for Hollerith strings */
463 {
464 if( ! isdigit((int)j[-1])) goto copychar;
465 nh = j[-1] - '0';
466 ten = 10;
467 j1 = prvstr - 1;
468 if (j1<j-5) j1=j-5;
469 for(j0=j-2 ; j0>j1; -- j0)
470 {
471 if( ! isdigit((int)*j0 ) ) break;
472 nh += ten * (*j0-'0');
473 ten*=10;
474 }
475 if(j0 <= j1) goto copychar;
476 /* a hollerith must be preceded by a punctuation mark.
477 '*' is possible only as repetition factor in a data statement
478 not, in particular, in character*2h
479 */
480
481 if( !(*j0=='*'&&s[0]=='d') && *j0!='/' && *j0!='(' &&
482 *j0!=',' && *j0!='=' && *j0!='.')
483 goto copychar;
484 if(i+nh > lastch)
485 {
486 err1("%dH too big", nh);
487 nh = lastch - i;
488 }
489 j0[1] = MYQUOTE; /* special marker */
490 j = j0 + 1;
491 while(nh-- > 0)
492 {
493 if(*++i == '\\')
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 '0':
505 *i = '\0'; break;
506 default:
507 break;
508 }
509 *++j = *i;
510 }
511 j[1] = MYQUOTE;
512 j+=2;
513 prvstr = j;
514 }
515 else {
516 if(*i == '(') ++parlev;
517 else if(*i == ')') --parlev;
518 else if(parlev == 0) {
519 if(*i == '=') expeql = 1;
520 else if(*i == ',') expcom = 1;
521 copychar: ; /*not a string of BLANK -- copy, shifting case if necessary */
522 }
523 if(shiftcase && isupper((int)*i))
524 *j++ = tolower((int)*i);
525 else *j++ = *i;
526 }
527 }
528 lastch = j - 1;
529 nextch = s;
530 }
531
532 LOCAL void
analyz()533 analyz()
534 {
535 register char *i;
536
537 if(parlev != 0)
538 {
539 err("unbalanced parentheses, statement skipped");
540 stkey = SUNKNOWN;
541 return;
542 }
543 if(nextch+2<=lastch && nextch[0]=='i' && nextch[1]=='f' && nextch[2]=='(')
544 {
545 /* assignment or if statement -- look at character after balancing paren */
546 parlev = 1;
547 for(i=nextch+3 ; i<=lastch; ++i)
548 if(*i == (MYQUOTE))
549 {
550 while(*++i != MYQUOTE)
551 ;
552 }
553 else if(*i == '(')
554 ++parlev;
555 else if(*i == ')')
556 {
557 if(--parlev == 0)
558 break;
559 }
560 if(i >= lastch)
561 stkey = SLOGIF;
562 else if(i[1] == '=')
563 stkey = SLET;
564 else if( isdigit((int)i[1]) )
565 stkey = SARITHIF;
566 else stkey = SLOGIF;
567 if(stkey != SLET)
568 nextch += 2;
569 }
570 else if(expeql) /* may be an assignment */
571 {
572 if(expcom && nextch<lastch &&
573 nextch[0]=='d' && nextch[1]=='o')
574 {
575 stkey = SDO;
576 nextch += 2;
577 }
578 else stkey = SLET;
579 }
580 /* otherwise search for keyword */
581 else {
582 stkey = getkwd();
583 if(stkey==SGOTO && lastch>=nextch) {
584 if(nextch[0]=='(')
585 stkey = SCOMPGOTO;
586 else if(isalpha((int)nextch[0]))
587 stkey = SASGOTO;
588 }
589 }
590 parlev = 0;
591 }
592
593
594
595 LOCAL int
getkwd()596 getkwd()
597 {
598 register char *i, *j;
599 register struct keylist *pk, *pend;
600 int k;
601
602 if(! isalpha((int)nextch[0]) )
603 return(SUNKNOWN);
604 k = nextch[0] - 'a';
605 if((pk = keystart[k]))
606 for(pend = keyend[k] ; pk<=pend ; ++pk )
607 {
608 i = pk->keyname;
609 j = nextch;
610 while(*++i==*++j && *i!='\0')
611 ;
612 if(*i == '\0')
613 {
614 nextch = j;
615 return(pk->keyval);
616 }
617 }
618 return(SUNKNOWN);
619 }
620
621
622 void
initkey()623 initkey()
624 {
625 register struct keylist *p;
626 register int i,j;
627
628 for(i = 0 ; i<26 ; ++i)
629 keystart[i] = NULL;
630
631 for(p = keys ; p->keyname ; ++p)
632 {
633 j = p->keyname[0] - 'a';
634 if(keystart[j] == NULL)
635 keystart[j] = p;
636 keyend[j] = p;
637 }
638 }
639
640 LOCAL int
gettok()641 gettok()
642 {
643 int havdot, havexp, havdbl;
644 int radix;
645 extern struct punctlist puncts[];
646 struct punctlist *pp;
647 #if 0
648 extern struct fmtlist fmts[];
649 #endif
650 struct dotlist *pd;
651
652 char *i, *j, *n1, *p;
653
654 if(*nextch == (MYQUOTE))
655 {
656 ++nextch;
657 p = token;
658 while(*nextch != MYQUOTE)
659 *p++ = *nextch++;
660 ++nextch;
661 toklen = p - token;
662 *p = '\0';
663 return (SHOLLERITH);
664 }
665 /*
666 if(stkey == SFORMAT)
667 {
668 for(pf = fmts; pf->fmtchar; ++pf)
669 {
670 if(*nextch == pf->fmtchar)
671 {
672 ++nextch;
673 if(pf->fmtval == SLPAR)
674 ++parlev;
675 else if(pf->fmtval == SRPAR)
676 --parlev;
677 return(pf->fmtval);
678 }
679 }
680 if( isdigit(*nextch) )
681 {
682 p = token;
683 *p++ = *nextch++;
684 while(nextch<=lastch && isdigit(*nextch) )
685 *p++ = *nextch++;
686 toklen = p - token;
687 *p = '\0';
688 if(nextch<=lastch && *nextch=='p')
689 {
690 ++nextch;
691 return(SSCALE);
692 }
693 else return(SICON);
694 }
695 if( isalpha(*nextch) )
696 {
697 p = token;
698 *p++ = *nextch++;
699 while(nextch<=lastch &&
700 (*nextch=='.' || isdigit(*nextch) || isalpha(*nextch) ))
701 *p++ = *nextch++;
702 toklen = p - token;
703 *p = '\0';
704 return(SFIELD);
705 }
706 goto badchar;
707 }
708 XXX ??? */
709 /* Not a format statement */
710
711 if(needkwd)
712 {
713 needkwd = 0;
714 return( getkwd() );
715 }
716
717 for(pp=puncts; pp->punchar; ++pp)
718 if(*nextch == pp->punchar)
719 {
720 if( (*nextch=='*' || *nextch=='/') &&
721 nextch<lastch && nextch[1]==nextch[0])
722 {
723 if(*nextch == '*')
724 yylval.num = SPOWER;
725 else yylval.num = SCONCAT;
726 nextch+=2;
727 }
728 else {yylval.num=pp->punval;
729 if(yylval.num==SLPAR)
730 ++parlev;
731 else if(yylval.num==SRPAR)
732 --parlev;
733 ++nextch;
734 }
735 return(yylval.num);
736 }
737 if(*nextch == '.') {
738 if(nextch >= lastch) goto badchar;
739 else if(isdigit((int)nextch[1])) goto numconst;
740 else {
741 for(pd=dots ; (j=pd->dotname) ; ++pd)
742 {
743 for(i=nextch+1 ; i<=lastch ; ++i)
744 if(*i != *j) break;
745 else if(*i != '.') ++j;
746 else {
747 nextch = i+1;
748 return(pd->dotval);
749 }
750 }
751 goto badchar;
752 }
753 }
754 if( isalpha((int)*nextch) )
755 {
756 p = token;
757 *p++ = *nextch++;
758 while(nextch<=lastch)
759 if( isalpha((int)*nextch) || isdigit((int)*nextch) )
760 *p++ = *nextch++;
761 else break;
762 toklen = p - token;
763 *p = '\0';
764 if(inioctl && nextch<=lastch && *nextch=='=')
765 {
766 ++nextch;
767 return(SNAMEEQ);
768 }
769 if(toklen>=8 && eqn(8, token, "function") &&
770 nextch<lastch && *nextch=='(')
771 {
772 nextch -= (toklen - 8);
773 return(SFUNCTION);
774 }
775 if(toklen > VL)
776 {
777 err2("name %s too long, truncated to %d", token, VL);
778 toklen = VL;
779 token[6] = '\0';
780 }
781 if(toklen==1 && *nextch==MYQUOTE)
782 {
783 switch(token[0])
784 {
785 case 'z': case 'Z':
786 case 'x': case 'X':
787 radix = 16; break;
788 case 'o': case 'O':
789 radix = 8; break;
790 case 'b': case 'B':
791 radix = 2; break;
792 default:
793 err("bad bit identifier");
794 return(SFNAME);
795 }
796 ++nextch;
797 for(p = token ; *nextch!=MYQUOTE ; )
798 if( hextoi(*p++ = *nextch++) >= radix)
799 {
800 err("invalid binary character");
801 break;
802 }
803 ++nextch;
804 toklen = p - token;
805 return( radix==16 ? SHEXCON : (radix==8 ? SOCTCON : SBITCON) );
806 }
807 return(SFNAME);
808 }
809 if( ! isdigit((int)*nextch) ) goto badchar;
810 numconst:
811 havdot = NO;
812 havexp = NO;
813 havdbl = NO;
814 for(n1 = nextch ; nextch<=lastch ; ++nextch)
815 {
816 if(*nextch == '.')
817 if(havdot) break;
818 else if(nextch+2<=lastch && isalpha((int)nextch[1])
819 && isalpha((int)nextch[2]))
820 break;
821 else havdot = YES;
822 else if(*nextch=='d' || *nextch=='e')
823 {
824 p = nextch;
825 havexp = YES;
826 if(*nextch == 'd')
827 havdbl = YES;
828 if(nextch<lastch)
829 if(nextch[1]=='+' || nextch[1]=='-')
830 ++nextch;
831 if( ! isdigit((int)*++nextch) )
832 {
833 nextch = p;
834 havdbl = havexp = NO;
835 break;
836 }
837 for(++nextch ;
838 nextch<=lastch && isdigit((int)*nextch);
839 ++nextch);
840 break;
841 }
842 else if( ! isdigit((int)*nextch) )
843 break;
844 }
845 p = token;
846 i = n1;
847 while(i < nextch)
848 *p++ = *i++;
849 toklen = p - token;
850 *p = '\0';
851 if(havdbl) return(SDCON);
852 if(havdot || havexp) return(SRCON);
853 return(SICON);
854 badchar:
855 s[0] = *nextch++;
856 return(SUNKNOWN);
857 }
858
859 /* KEYWORD AND SPECIAL CHARACTER TABLES
860 */
861
862 struct punctlist puncts[ ] =
863 {
864 { '(', SLPAR, },
865 { ')', SRPAR, },
866 { '=', SEQUALS, },
867 { ',', SCOMMA, },
868 { '+', SPLUS, },
869 { '-', SMINUS, },
870 { '*', SSTAR, },
871 { '/', SSLASH, },
872 { '$', SCURRENCY, },
873 { ':', SCOLON, },
874 { 0, 0 }, } ;
875
876 /*
877 LOCAL struct fmtlist fmts[ ] =
878 {
879 '(', SLPAR,
880 ')', SRPAR,
881 '/', SSLASH,
882 ',', SCOMMA,
883 '-', SMINUS,
884 ':', SCOLON,
885 0, 0 } ;
886 */
887
888 LOCAL struct dotlist dots[ ] =
889 {
890 { "and.", SAND, },
891 { "or.", SOR, },
892 { "not.", SNOT, },
893 { "true.", STRUE, },
894 { "false.", SFALSE, },
895 { "eq.", SEQ, },
896 { "ne.", SNE, },
897 { "lt.", SLT, },
898 { "le.", SLE, },
899 { "gt.", SGT, },
900 { "ge.", SGE, },
901 { "neqv.", SNEQV, },
902 { "eqv.", SEQV, },
903 { 0, 0 }, } ;
904
905 LOCAL struct keylist keys[ ] =
906 {
907 { "assign", SASSIGN, },
908 { "automatic", SAUTOMATIC, },
909 { "backspace", SBACKSPACE, },
910 { "blockdata", SBLOCK, },
911 { "call", SCALL, },
912 { "character", SCHARACTER, },
913 { "close", SCLOSE, },
914 { "common", SCOMMON, },
915 { "complex", SCOMPLEX, },
916 { "continue", SCONTINUE, },
917 { "data", SDATA, },
918 { "dimension", SDIMENSION, },
919 { "doubleprecision", SDOUBLE, },
920 { "doublecomplex", SDCOMPLEX, },
921 { "elseif", SELSEIF, },
922 { "else", SELSE, },
923 { "endfile", SENDFILE, },
924 { "endif", SENDIF, },
925 { "end", SEND, },
926 { "entry", SENTRY, },
927 { "equivalence", SEQUIV, },
928 { "external", SEXTERNAL, },
929 { "format", SFORMAT, },
930 { "function", SFUNCTION, },
931 { "goto", SGOTO, },
932 { "implicit", SIMPLICIT, },
933 { "include", SINCLUDE, },
934 { "inquire", SINQUIRE, },
935 { "intrinsic", SINTRINSIC, },
936 { "integer", SINTEGER, },
937 { "logical", SLOGICAL, },
938 { "open", SOPEN, },
939 { "parameter", SPARAM, },
940 { "pause", SPAUSE, },
941 { "print", SPRINT, },
942 { "program", SPROGRAM, },
943 { "punch", SPUNCH, },
944 { "read", SREAD, },
945 { "real", SREAL, },
946 { "return", SRETURN, },
947 { "rewind", SREWIND, },
948 { "save", SSAVE, },
949 { "static", SSTATIC, },
950 { "stop", SSTOP, },
951 { "subroutine", SSUBROUTINE, },
952 { "then", STHEN, },
953 { "undefined", SUNDEFINED, },
954 { "write", SWRITE, },
955 { 0, 0 }, };
956