lex.c

把fortran语言编的程序转为c语言编的程序, 运行环境linux

	}

	if (retval == SEOF)
	    flush_comments ();

	return retval;
}

 LOCAL void
contmax(Void)
{
	lineno = thislin;
	many("continuation lines", 'C', maxcontin);
	}

/* Get Cards.

   Returns STEOF or STINITIAL, never STCONTINUE.  Any continuation cards get
merged into one long card (hence the size of the buffer named   sbuf)   */

 LOCAL int
getcds(Void)
{
	register char *p, *q;

	flush_comments ();
top:
	if(nextcd == NULL)
	{
		code = getcd( nextcd = sbuf, 1 );
		stno = nxtstno;
		prevlin = thislin;
	}
	if(code == STEOF)
		if( popinclude() )
			goto top;
		else
			return(STEOF);

	if(code == STCONTINUE)
	{
		lineno = thislin;
		nextcd = NULL;
		goto top;
	}

/* Get rid of unused space at the head of the buffer */

	if(nextcd > sbuf)
	{
		q = nextcd;
		p = sbuf;
		while(q < endcd)
			*p++ = *q++;
		endcd = p;
	}

/* Be aware that the input (i.e. the string at the address   nextcd)   is NOT
   NULL-terminated */

/* This loop merges all continuations into one long statement, AND puts the next
   card to be read at the end of the buffer (i.e. it stores the look-ahead card
   when there's room) */

	ncont = 0;
	for(;;) {
		nextcd = endcd;
		if (ncont >= maxcont || nextcd+66 > send)
			contmax();
		linestart[ncont++] = nextcd;
		if ((code = getcd(nextcd,0)) != STCONTINUE)
			break;
		if (ncont == 20 && noextflag) {
			lineno = thislin;
			errext("more than 19 continuation lines");
			}
		}
	nextch = sbuf;
	lastch = nextcd - 1;

	lineno = prevlin;
	prevlin = thislin;
	return(STINITIAL);
}

 static void
#ifdef KR_headers
bang(a, b, c, d, e)
	char *a;
	char *b;
	char *c;
	register char *d;
	register char *e;
#else
bang(char *a, char *b, char *c, register char *d, register char *e)
#endif
		/* save ! comments */
{
	char buf[COMMENT_BUFFER_SIZE + 1];
	register char *p, *pe;

	p = buf;
	pe = buf + COMMENT_BUFFER_SIZE;
	*pe = 0;
	while(a < b)
		if (!(*p++ = *a++))
			p[-1] = 0;
	if (b < c)
		*p++ = '\t';
	while(d < e) {
		if (!(*p++ = *d++))
			p[-1] = ' ';
		if (p == pe) {
			store_comment(buf);
			p = buf;
			}
		}
	if (p > buf) {
		while(--p >= buf && *p == ' ');
		p[1] = 0;
		store_comment(buf);
		}
	}


/* getcd - Get next input card

	This function reads the next input card from global file pointer   infile.
It assumes that   b   points to currently empty storage somewhere in  sbuf  */

 LOCAL int
#ifdef KR_headers
getcd(b, nocont)
	register char *b;
	int nocont;
#else
getcd(register char *b, int nocont)
#endif
{
	register int c;
	register char *p, *bend;
	int speclin;		/* Special line - true when the line is allowed
				   to have more than 66 characters (e.g. the
				   "&" shorthand for continuation, use of a "\t"
				   to skip part of the label columns) */
	static char a[6];	/* Statement label buffer */
	static char *aend	= a+6;
	static char *stb, *stbend;
	static int nst;
	char *atend, *endcd0;
	extern int warn72;
	char buf72[24];
	int amp, i;
	char storage[COMMENT_BUFFER_SIZE + 1];
	char *pointer;
	long L;

top:
	endcd = b;
	bend = b+66;
	amp = speclin = NO;
	atend = aend;

/* Handle the continuation shorthand of "&" in the first column, which stands
   for "     x" */

	if( (c = getc(infile)) == '&')
	{
		a[0] = c;
		a[1] = 0;
		a[5] = 'x';
		amp = speclin = YES;
		bend = send;
		p = aend;
	}

/* Handle the Comment cards (a 'C', 'c', '*', or '!' in the first column). */

	else if(comstart[c & 0xfff])
	{
		if (feof (infile)
#ifdef EOF_CHAR
			 || c == EOF_CHAR
#endif
					)
		    return STEOF;

		if (c == '#') {
			*endcd++ = c;
			while((c = getc(infile)) != '\n')
				if (c == EOF)
					return STEOF;
				else if (endcd < bend)
					*endcd++ = c;
			++thislin;
			*endcd = 0;
			if (b[1] == ' ')
				p = b + 2;
			else if (!strncmp(b,"#line ",6))
				p = b + 6;
			else {
 bad_cpp:
				errstr("Bad # line: \"%s\"", b);
				goto top;
				}
			if (*p < '1' || *p > '9')
				goto bad_cpp;
			L = *p - '0';
			while((c = *++p) >= '0' && c <= '9')
				L = 10*L + c - '0';
			if (c != ' ' || *++p != '"')
				goto bad_cpp;
			bend = p;
			while(*++p != '"')
				if (!*p)
					goto bad_cpp;
			*p = 0;
			i = p - bend++;
			thislin = L - 1;
			if (!infname || strcmp(infname, bend)) {
				if (infname)
					free(infname);
				lastfile = 0;
				infname = Alloc(i);
				strcpy(infname, bend);
				if (inclp)
					inclp->inclname = infname;
				}
			goto top;
			}

		storage[COMMENT_BUFFER_SIZE] = c = '\0';
		pointer = storage;
		while( !feof (infile) && (*pointer++ = c = getc(infile)) != '\n') {

/* Handle obscure end of file conditions on many machines */

			if (feof (infile) && (c == '\377' || c == EOF)) {
			    pointer--;
			    break;
			} /* if (feof (infile)) */

			if (c == '\0')
				*(pointer - 1) = ' ';

			if (pointer == &storage[COMMENT_BUFFER_SIZE]) {
				store_comment (storage);
				pointer = storage;
			} /* if (pointer == BUFFER_SIZE) */
		} /* while */

		if (pointer > storage) {
		    if (c == '\n')

/* Get rid of the newline */

			pointer[-1] = 0;
		    else
			*pointer = 0;

		    store_comment (storage);
		} /* if */

		if (feof (infile))
		    if (c != '\n')	/* To allow the line index to
					   increment correctly */
			return STEOF;

		++thislin;
		goto top;
	}

	else if(c != EOF)
	{

/* Load buffer   a   with the statement label */

		/* a tab in columns 1-6 skips to column 7 */
		ungetc(c, infile);
		for(p=a; p<aend && (c=getc(infile)) != '\n' && c!=EOF; )
			if(c == '\t')

/* The tab character translates into blank characters in the statement label */

			{
				atend = p;
				while(p < aend)
					*p++ = BLANK;
				speclin = YES;
				bend = send;
			}
			else
				*p++ = c;
	}

/* By now we've read either a continuation character or the statement label
   field */

	if(c == EOF)
		return(STEOF);

/* The next 'if' block handles lines that have fewer than 7 characters */

	if(c == '\n')
	{
		while(p < aend)
			*p++ = BLANK;

/* Blank out the buffer on lines which are not longer than 66 characters */

		endcd0 = endcd;
		if( ! speclin )
			while(endcd < bend)
				*endcd++ = BLANK;
	}
	else	{	/* read body of line */
		if (warn72 & 2) {
			speclin = YES;
			bend = send;
			}
		while( endcd<bend && (c=getc(infile)) != '\n' && c!=EOF )
			*endcd++ = c;
		if(c == EOF)
			return(STEOF);

/* Drop any extra characters on the input card; this usually means those after
   column 72 */

		if(c != '\n')
		{
			i = 0;
			while( (c=getc(infile)) != '\n' && c != EOF)
				if (i < 23)
					buf72[i++] = c;
			if (warn72 && i && !speclin) {
				buf72[i] = 0;
				if (i >= 23)
					strcpy(buf72+20, "...");
				lineno = thislin + 1;
				errstr("text after column 72: %s", buf72);
				}
			if(c == EOF)
				return(STEOF);
		}

		endcd0 = endcd;
		if( ! speclin )
			while(endcd < bend)
				*endcd++ = BLANK;
	}

/* The flow of control usually gets to this line (unless an earlier RETURN has
   been taken) */

	++thislin;

	/* Fortran 77 specifies that a 0 in column 6 */
	/* does not signify continuation */

	if( !isspace(a[5]) && a[5]!='0') {
		if (!amp)
			for(p = a; p < aend;)
				if (*p++ == '!' && p != aend)
					goto initcheck;
		if (addftnsrc && stb) {
			if (stbend > stb + 7) { /* otherwise forget col 1-6 */
				/* kludge around funny p1gets behavior */
				*stb++ = '$';
				if (amp)
					*stb++ = '&';
				else
					for(p = a; p < atend;)
						*stb++ = *p++;
				}
			if (endcd0 - b > stbend - stb) {
				if (stb > stbend)
					stb = stbend;
				endcd0 = b + (stbend - stb);
				}
			for(p = b; p < endcd0;)
				*stb++ = *p++;
			*stb++ = '\n';
			*stb = 0;
			}
		if (nocont) {
			lineno = thislin;
			errstr("illegal continuation card (starts \"%.6s\")",a);
			}
		else if (!amp && strncmp(a,"     ",5)) {
			lineno = thislin;
			errstr("labeled continuation line (starts \"%.6s\")",a);
			}
		return(STCONTINUE);
		}
initcheck:
	for(p=a; p<atend; ++p)
		if( !isspace(*p) ) {
			if (*p++ != '!')
				goto initline;
			bang(p, atend, aend, b, endcd);
			goto top;
			}
	for(p = b ; p<endcd ; ++p)
		if( !isspace(*p) ) {
			if (*p++ != '!')
				goto initline;
			bang(a, a, a, p, endcd);
			goto top;
			}

/* Skip over blank cards by reading the next one right away */

	goto top;

initline:
	if (!lastline)
		lastline = thislin;
	if (addftnsrc) {
		nst = (nst+1)%3;
		if (!laststb && stb0)
			laststb = stb0;
		stb0 = stb = stbuf[nst];
		*stb++ = '$';	/* kludge around funny p1gets behavior */
		stbend = stb + sizeof(stbuf[0])-2;
		for(p = a; p < atend;)
			*stb++ = *p++;
		if (atend < aend)
			*stb++ = '\t';
		for(p = b; p < endcd0;)
			*stb++ = *p++;
		*stb++ = '\n';
		*stb = 0;
		}

/* Set   nxtstno   equal to the integer value of the statement label */

	nxtstno = 0;
	bend = a + 5;
	for(p = a ; p < bend ; ++p)
		if( !isspace(*p) )
			if(isdigit(*p))
				nxtstno = 10*nxtstno + (*p - '0');
			else if (*p == '!') {
				if (!addftnsrc)
					bang(p+1,atend,aend,b,endcd);
				endcd = b;
				break;
				}
			else	{
				lineno = thislin;
				errstr(
				"nondigit in statement label field \"%.5s\"", a);
				nxtstno = 0;
				break;
			}
	firstline = thislin;
	return(STINITIAL);
}


/* crunch -- deletes all space characters, folds the backslash chars and
   Hollerith strings, quotes the Fortran strings */

 LOCAL void
crunch(Void)
{
	register char *i, *j, *j0, *j1, *prvstr;
	int k, ten, nh, nh0, quote;

	/* i is the next input character to be looked at
	   j is the next output character */

	new_dcl = needwkey = parlev = parseen = 0;
	expcom = 0;	/* exposed ','s */
	expeql = 0;	/* exposed equal signs */
	j = sbuf;
	prvstr = sbuf;
	k = 0;
	for(i=sbuf ; i<=lastch ; ++i)
	{
		if(isspace(*i) )
			continue;
		if (*i == '!') {
			while(i >= linestart[k])
				if (++k >= maxcont)
					contmax();
			j0 = linestart[k];
			if (!addftnsrc)
				bang(sbuf,sbuf,sbuf,i+1,j0);
			i = j0-1;
			continue;
			}

/* Keep everything in a quoted string */

		if(*i=='\'' ||  *i=='"')
		{
			int len = 0;

			quote = *i;
			*j = MYQUOTE; /* special marker */
			for(;;)
			{
				if(++i > lastch)
				{
					err("unbalanced quotes; closing quote supplied");
					if (j >= lastch)
						j = lastch - 1;
					break;
				}
				if(*i == quote)
					if(i<lastch && i[1]==quote) ++i;
					else break;
				else if(*i=='\\' && i<lastch && use_bs) {
					++i;
					*i = escapes[*(unsigned char *)i];
					}
				if (len < MAXTOKENLEN)
				    *++j = *i;
				else if (len == MAXTOKENLEN)
				    erri
	    ("String too long, truncating to %d chars", MAXTOKENLEN);
				len++;
			} /* for (;;) */

			j[1] = MYQUOTE;
			j += 2;
			prvstr = j;
		}
		else if( (*i=='h' || *i=='H')  && j>prvstr)	/* test for Hollerith strings */
		{
			j0 = j - 1;
			if( ! isdigit(*j0)) goto copychar;
			nh = *j0 - '0';
			ten = 10;
			j1 = prvstr;
			if (j1+4 < j)
				j1 = j-4;
			for(;;) {
				if (j0-- <= j1)
					goto copychar;
				if( ! isdigit(*j0 ) ) break;
				nh += ten * (*j0-'0');
				ten*=10;
				}
			/* a hollerith must be preceded by a punctuation mark.
   '*' is possible only as repetition factor in a data statement
   not, in particular, in character*2h
*/

			if( !(*j0=='*'&&sbuf[0]=='d') && *j0!='/'
			&& *j0!='(' && *j0!=',' && *j0!='=' && *j0!='.')
				goto copychar;
			nh0 = nh;
			if(i+nh > lastch || nh > MAXTOKENLEN)