Context Navigation

source: mainline/uspace/app/pcc/f77/fcom/lex.c@ c6a7b3a

Visit:

lfn serial ticket/834-toolchain-update topic/msim-upgrade topic/simplify-dev-export

Last change on this file since c6a7b3a was a7de7182, checked in by Jiří Zárevúcky <zarevucky.jiri@…>, 14 years ago
Added pcc source tree (contents of pcc-1.0.0.tgz)
Property mode set to `100644`
File size: 17.9 KB

Line
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+2066;
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
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
123	flline()
124	{
125	lexstate = RETEOS;
126	}
127
128
129
130	char *lexline(n)
131	ftnint *n;
132	{
133	*n = (lastch - nextch) + 1;
134	return(nextch);
135	}
136
137
138
139
140	void
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
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
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
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
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 = 10nxtstno + (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
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
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
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
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
641	LOCAL int
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
861	/* KEYWORD AND SPECIAL CHARACTER TABLES
862	*/
863
864	struct punctlist puncts[ ] =
865	{
866	{ '(', SLPAR, },
867	{ ')', SRPAR, },
868	{ '=', SEQUALS, },
869	{ ',', SCOMMA, },
870	{ '+', SPLUS, },
871	{ '-', SMINUS, },
872	{ '*', SSTAR, },
873	{ '/', SSLASH, },
874	{ '$', SCURRENCY, },
875	{ ':', SCOLON, },
876	{ 0, 0 }, } ;
877
878	/*
879	LOCAL struct fmtlist fmts[ ] =
880	{
881	'(', SLPAR,
882	')', SRPAR,
883	'/', SSLASH,
884	',', SCOMMA,
885	'-', SMINUS,
886	':', SCOLON,
887	0, 0 } ;
888	*/
889
890	LOCAL struct dotlist dots[ ] =
891	{
892	{ "and.", SAND, },
893	{ "or.", SOR, },
894	{ "not.", SNOT, },
895	{ "true.", STRUE, },
896	{ "false.", SFALSE, },
897	{ "eq.", SEQ, },
898	{ "ne.", SNE, },
899	{ "lt.", SLT, },
900	{ "le.", SLE, },
901	{ "gt.", SGT, },
902	{ "ge.", SGE, },
903	{ "neqv.", SNEQV, },
904	{ "eqv.", SEQV, },
905	{ 0, 0 }, } ;
906
907	LOCAL struct keylist keys[ ] =
908	{
909	{ "assign", SASSIGN, },
910	{ "automatic", SAUTOMATIC, },
911	{ "backspace", SBACKSPACE, },
912	{ "blockdata", SBLOCK, },
913	{ "call", SCALL, },
914	{ "character", SCHARACTER, },
915	{ "close", SCLOSE, },
916	{ "common", SCOMMON, },
917	{ "complex", SCOMPLEX, },
918	{ "continue", SCONTINUE, },
919	{ "data", SDATA, },
920	{ "dimension", SDIMENSION, },
921	{ "doubleprecision", SDOUBLE, },
922	{ "doublecomplex", SDCOMPLEX, },
923	{ "elseif", SELSEIF, },
924	{ "else", SELSE, },
925	{ "endfile", SENDFILE, },
926	{ "endif", SENDIF, },
927	{ "end", SEND, },
928	{ "entry", SENTRY, },
929	{ "equivalence", SEQUIV, },
930	{ "external", SEXTERNAL, },
931	{ "format", SFORMAT, },
932	{ "function", SFUNCTION, },
933	{ "goto", SGOTO, },
934	{ "implicit", SIMPLICIT, },
935	{ "include", SINCLUDE, },
936	{ "inquire", SINQUIRE, },
937	{ "intrinsic", SINTRINSIC, },
938	{ "integer", SINTEGER, },
939	{ "logical", SLOGICAL, },
940	{ "open", SOPEN, },
941	{ "parameter", SPARAM, },
942	{ "pause", SPAUSE, },
943	{ "print", SPRINT, },
944	{ "program", SPROGRAM, },
945	{ "punch", SPUNCH, },
946	{ "read", SREAD, },
947	{ "real", SREAL, },
948	{ "return", SRETURN, },
949	{ "rewind", SREWIND, },
950	{ "save", SSAVE, },
951	{ "static", SSTATIC, },
952	{ "stop", SSTOP, },
953	{ "subroutine", SSUBROUTINE, },
954	{ "then", STHEN, },
955	{ "undefined", SUNDEFINED, },
956	{ "write", SWRITE, },
957	{ 0, 0 }, };

Note: See TracBrowser for help on using the repository browser.

Download in other formats: