lex.c

unix v7是最后一个广泛发布的研究型UNIX版本

						*i = '\b'; break;
					case 'n':
						*i = '\n'; break;
					case 'f':
						*i = '\f'; break;
					case '0':
						*i = '\0'; break;
					default:
						break;
					}
			*++j = *i;
			}
		j[1] = MYQUOTE;
		j+=2;
		prvstr = j;
		}
	else	{
		if(*i == '(') ++parlev;
		else if(*i == ')') --parlev;
		else if(parlev == 0)
			if(*i == '=') expeql = 1;
			else if(*i == ',') expcom = 1;
copychar:		/*not a string or space -- copy, shifting case if necessary */
		if(shiftcase && isupper(*i))
			*j++ = tolower(*i);
		else	*j++ = *i;
		}
	}
lastch = j - 1;
nextch = s;
}

LOCAL analyz()
{
register char *i;

	if(parlev != 0)
		{
		err("unbalanced parentheses, statement skipped");
		stkey = SUNKNOWN;
		return;
		}
	if(nextch+2<=lastch && nextch[0]=='i' && nextch[1]=='f' && nextch[2]=='(')
		{
/* assignment or if statement -- look at character after balancing paren */
		parlev = 1;
		for(i=nextch+3 ; i<=lastch; ++i)
			if(*i == (MYQUOTE))
				{
				while(*++i != MYQUOTE)
					;
				}
			else if(*i == '(')
				++parlev;
			else if(*i == ')')
				{
				if(--parlev == 0)
					break;
				}
		if(i >= lastch)
			stkey = SLOGIF;
		else if(i[1] == '=')
			stkey = SLET;
		else if( isdigit(i[1]) )
			stkey = SARITHIF;
		else	stkey = SLOGIF;
		if(stkey != SLET)
			nextch += 2;
		}
	else if(expeql) /* may be an assignment */
		{
		if(expcom && nextch<lastch &&
			nextch[0]=='d' && nextch[1]=='o')
				{
				stkey = SDO;
				nextch += 2;
				}
		else	stkey = SLET;
		}
/* otherwise search for keyword */
	else	{
		stkey = getkwd();
		if(stkey==SGOTO && lastch>=nextch)
			if(nextch[0]=='(')
				stkey = SCOMPGOTO;
			else if(isalpha(nextch[0]))
				stkey = SASGOTO;
		}
	parlev = 0;
}



LOCAL getkwd()
{
register char *i, *j;
register struct keylist *pk, *pend;
int k;

if(! isalpha(nextch[0]) )
	return(SUNKNOWN);
k = nextch[0] - 'a';
if(pk = keystart[k])
	for(pend = keyend[k] ; pk<=pend ; ++pk )
		{
		i = pk->keyname;
		j = nextch;
		while(*++i==*++j && *i!='\0')
			;
		if(*i=='\0' && j<=lastch+1)
			{
			nextch = j;
			return(pk->keyval);
			}
		}
return(SUNKNOWN);
}



initkey()
{
extern struct keylist keys[];
register struct keylist *p;
register int i,j;

for(i = 0 ; i<26 ; ++i)
	keystart[i] = NULL;

for(p = keys ; p->keyname ; ++p)
	{
	j = p->keyname[0] - 'a';
	if(keystart[j] == NULL)
		keystart[j] = p;
	keyend[j] = p;
	}
}

LOCAL gettok()
{
int havdot, havexp, havdbl;
int radix;
extern struct punctlist puncts[];
struct punctlist *pp;
extern struct fmtlist fmts[];
extern struct dotlist dots[];
struct dotlist *pd;

char *i, *j, *n1, *p;

	if(*nextch == (MYQUOTE))
		{
		++nextch;
		p = token;
		while(*nextch != MYQUOTE)
			*p++ = *nextch++;
		++nextch;
		toklen = p - token;
		*p = '\0';
		return (SHOLLERITH);
		}
/*
	if(stkey == SFORMAT)
		{
		for(pf = fmts; pf->fmtchar; ++pf)
			{
			if(*nextch == pf->fmtchar)
				{
				++nextch;
				if(pf->fmtval == SLPAR)
					++parlev;
				else if(pf->fmtval == SRPAR)
					--parlev;
				return(pf->fmtval);
				}
			}
		if( isdigit(*nextch) )
			{
			p = token;
			*p++ = *nextch++;
			while(nextch<=lastch && isdigit(*nextch) )
				*p++ = *nextch++;
			toklen = p - token;
			*p = '\0';
			if(nextch<=lastch && *nextch=='p')
				{
				++nextch;
				return(SSCALE);
				}
			else	return(SICON);
			}
		if( isalpha(*nextch) )
			{
			p = token;
			*p++ = *nextch++;
			while(nextch<=lastch &&
				(*nextch=='.' || isdigit(*nextch) || isalpha(*nextch) ))
					*p++ = *nextch++;
			toklen = p - token;
			*p = '\0';
			return(SFIELD);
			}
		goto badchar;
		}
/* Not a format statement */

if(needkwd)
	{
	needkwd = 0;
	return( getkwd() );
	}

	for(pp=puncts; pp->punchar; ++pp)
		if(*nextch == pp->punchar)
			{
			if( (*nextch=='*' || *nextch=='/') &&
				nextch<lastch && nextch[1]==nextch[0])
					{
					if(*nextch == '*')
						yylval = SPOWER;
					else	yylval = SCONCAT;
					nextch+=2;
					}
			else	{yylval=pp->punval;
					if(yylval==SLPAR)
						++parlev;
					else if(yylval==SRPAR)
						--parlev;
					++nextch;
				}
			return(yylval);
			}
	if(*nextch == '.')
		if(nextch >= lastch) goto badchar;
		else if(isdigit(nextch[1])) goto numconst;
		else	{
			for(pd=dots ; (j=pd->dotname) ; ++pd)
				{
				for(i=nextch+1 ; i<=lastch ; ++i)
					if(*i != *j) break;
					else if(*i != '.') ++j;
					else	{
						nextch = i+1;
						return(pd->dotval);
						}
				}
			goto badchar;
			}
	if( isalpha(*nextch) )
		{
		p = token;
		*p++ = *nextch++;
		while(nextch<=lastch)
			if( isalpha(*nextch) || isdigit(*nextch) )
				*p++ = *nextch++;
			else break;
		toklen = p - token;
		*p = '\0';
		if(inioctl && nextch<=lastch && *nextch=='=')
			{
			++nextch;
			return(SNAMEEQ);
			}
		if(toklen>=8 && eqn(8, token, "function") &&
			nextch<lastch && *nextch=='(')
				{
				nextch -= (toklen - 8);
				return(SFUNCTION);
				}
		if(toklen > VL)
			{
			err2("name %s too long, truncated to %d", token, VL);
			toklen = VL;
			token[6] = '\0';
			}
		if(toklen==1 && *nextch==MYQUOTE)
			{
			switch(token[0])
				{
				case 'z':  case 'Z':
				case 'x':  case 'X':
					radix = 16; break;
				case 'o':  case 'O':
					radix = 8; break;
				case 'b':  case 'B':
					radix = 2; break;
				default:
					err("bad bit identifier");
					return(SNAME);
				}
			++nextch;
			for(p = token ; *nextch!=MYQUOTE ; )
				if( hextoi(*p++ = *nextch++) >= radix)
					{
					err("invalid binary character");
					break;
					}
			++nextch;
			toklen = p - token;
			return( radix==16 ? SHEXCON : (radix==8 ? SOCTCON : SBITCON) );
			}
		return(SNAME);
		}
	if( ! isdigit(*nextch) ) goto badchar;
numconst:
	havdot = NO;
	havexp = NO;
	havdbl = NO;
	for(n1 = nextch ; nextch<=lastch ; ++nextch)
		{
		if(*nextch == '.')
			if(havdot) break;
			else if(nextch+2<=lastch && isalpha(nextch[1])
				&& isalpha(nextch[2]))
					break;
			else	havdot = YES;
		else if(*nextch=='d' || *nextch=='e')
			{
			p = nextch;
			havexp = YES;
			if(*nextch == 'd')
				havdbl = YES;
			if(nextch<lastch)
				if(nextch[1]=='+' || nextch[1]=='-')
					++nextch;
			if( ! isdigit(*++nextch) )
				{
				nextch = p;
				havdbl = havexp = NO;
				break;
				}
			for(++nextch ;
				nextch<=lastch && isdigit(*nextch);
				++nextch);
			break;
			}
		else if( ! isdigit(*nextch) )
			break;
		}
	p = token;
	i = n1;
	while(i < nextch)
		*p++ = *i++;
	toklen = p - token;
	*p = '\0';
	if(havdbl) return(SDCON);
	if(havdot || havexp) return(SRCON);
	return(SICON);
badchar:
	s[0] = *nextch++;
	return(SUNKNOWN);
}

/* KEYWORD AND SPECIAL CHARACTER TABLES
*/

struct punctlist puncts[ ] =
	{
	'(', SLPAR,
	')', SRPAR,
	'=', SEQUALS,
	',', SCOMMA,
	'+', SPLUS,
	'-', SMINUS,
	'*', SSTAR,
	'/', SSLASH,
	'$', SCURRENCY,
	':', SCOLON,
	0, 0 } ;

/*
LOCAL struct fmtlist  fmts[ ] =
	{
	'(', SLPAR,
	')', SRPAR,
	'/', SSLASH,
	',', SCOMMA,
	'-', SMINUS,
	':', SCOLON,
	0, 0 } ;
*/

LOCAL struct dotlist  dots[ ] =
	{
	"and.", SAND, 
	"or.", SOR, 
	"not.", SNOT, 
	"true.", STRUE, 
	"false.", SFALSE, 
	"eq.", SEQ, 
	"ne.", SNE, 
	"lt.", SLT, 
	"le.", SLE, 
	"gt.", SGT, 
	"ge.", SGE, 
	"neqv.", SNEQV, 
	"eqv.", SEQV, 
	0, 0 } ;

LOCAL struct keylist  keys[ ] =
	{
	"assign",  SASSIGN,
	"automatic",  SAUTOMATIC,
	"backspace",  SBACKSPACE,
	"blockdata",  SBLOCK,
	"call",  SCALL,
	"character",  SCHARACTER,
	"close",  SCLOSE,
	"common",  SCOMMON,
	"complex",  SCOMPLEX,
	"continue",  SCONTINUE,
	"data",  SDATA,
	"dimension",  SDIMENSION,
	"doubleprecision",  SDOUBLE,
	"doublecomplex", SDCOMPLEX,
	"elseif",  SELSEIF,
	"else",  SELSE,
	"endfile",  SENDFILE,
	"endif",  SENDIF,
	"end",  SEND,
	"entry",  SENTRY,
	"equivalence",  SEQUIV,
	"external",  SEXTERNAL,
	"format",  SFORMAT,
	"function",  SFUNCTION,
	"goto",  SGOTO,
	"implicit",  SIMPLICIT,
	"include",  SINCLUDE,
	"inquire",  SINQUIRE,
	"intrinsic",  SINTRINSIC,
	"integer",  SINTEGER,
	"logical",  SLOGICAL,
	"open",  SOPEN,
	"parameter",  SPARAM,
	"pause",  SPAUSE,
	"print",  SPRINT,
	"program",  SPROGRAM,
	"punch",  SPUNCH,
	"read",  SREAD,
	"real",  SREAL,
	"return",  SRETURN,
	"rewind",  SREWIND,
	"save",  SSAVE,
	"static",  SSTATIC,
	"stop",  SSTOP,
	"subroutine",  SSUBROUTINE,
	"then",  STHEN,
	"undefined", SUNDEFINED,
	"write",  SWRITE,
	0, 0 };