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