USG_PG3/usr/source/lil/lexl.l

#include 'com'

"extern byte (_name sizeof NSIZE)";	% holds lookup name
"extern rsave(), rretrn()";		% special functions
"extern _sn, _compare, _lookup, _add, _lex, _dostring";

". = .data";
peek{	-1;	% holds returned lookahead character
}
". = .text";

get{	if (peek < 0) _getchar();
	else a = peek;
	if (a == '\0') peek = '\0';
	else peek = -1;
	if (a == '\n') _line + 1;
}	return;

putback{
	if (arg -> peek == '\n') _line - 1;
}	return;

alf{	arg -> a;
	if ('a' <= a && a <= 'z' || 'A' <= a && a <= 'Z' ||
		a == '.' || a == '_') a = TRUE;
	else a = FALSE;
}	return;

num{	if ('0' <= arg && arg <= '9') a = TRUE;
	else a = FALSE;
}	return;

op{	"\n = byte ='=+-<>?*/&~!|^'";
	a = 0;
	while (n[a] ~= '\0')
		{if (byte arg == n[a])
			{a = byte ='=+-<>?*/&!!^^'[a]; break op; }
		a + 1; }
	a = '\0';
}	return;

strend{	if (arg == '\'') {a = TRUE; break; }
	if (arg == '\n' || arg == '\0')
		{putback(arg);
		_error(='unbalanced \'');
		a = TRUE; break; }
	a = FALSE;
}	return;

strc{	if (a = arg ~= '\\') break;
	if (strend(get() -> arg)) {a = '\''; break; }
	if (a = arg == '0') a = 000;
	else if (a == 'a') a = 006;
	else if (a == 'e') a = 004;
	else if (a == 'n') a = 012;
	else if (a == 'p') a = 033;
	else if (a == 'r') a = 015;
	else if (a == 't') a = 011;
	else ;				% default is \x = x
}	return;

_sn{
	".data(byte tname sizeof (NSIZE + 2))";
	a = arg; b = 0;
	do tname[b] = byte [a]++; while (b + 1 < NSIZE);
	tname[b] = '\0';
	a = &tname;
}	return;

_compare{
	arg -> a = 0; arg2 -> b;
	do if (byte [a] ~= byte [b]++) {a = FALSE; break _compare; }
		while (byte [a]++ && arg + 1 < NSIZE);
	a = TRUE;
}	return;

_lookup{	"args(p1, n)";
	call; rsave; 0;
	e = _sptop;
	while (e ~= p1)
		{if (_compare(a = &name + e, n)) {a = e; break _lookup; }
		e = prev[e]; }
	a = NULL;
}	goto rretrn;


_add{	"args(s, byte f, byte t, v, z)";
	call; rsave; 0;
	if (_space - 1 < 0)
		{if (_sbrk("100 * SYMSIZE") < 0)
			{_error(='symbol table full');
			_exit(TRUE); }
		if (_symtab == NULL) _symtab = a;
		_space = 99; }
	b = _spused * SYMSIZE + _symtab -> e;
	_spused + 1;
	prev[e] = _sptop; _sptop = e;
	c = 0; d = &name + e;
	while (byte [s] ~= '\0' && c < NSIZE)
		{byte [d]++ = byte [s];
		s + 1; c + 1; }
	while (c < NSIZE) {byte [d]++ = '\0'; c + 1; }

	flags[e] = f; type[e] = t; value[e] = v;
	if (flags[e] ?& DEFF) a = 0;
	else a = e - _symtab * 1 / SYMSIZE;
	bias[e] = a;
	size[e] = z;
	a = e;
}	goto rretrn;

_lex{	call; rsave; &"auto(escape)";
	escape = FALSE;
	e = &_e;
	0 -> flags[e] -> value[e] -> bias[e];
	2 -> size[e];
	NULL -> prev[e] -> tbran[e] -> fbran[e];
    while (true) {
	if (get() == '%')
		{while (get() ~= '\n' && a ~= '\0') ; }
	if (a == ' ' || a == '\t' || a == '\n') continue;

	if (a == ';') {a = SCOLON; break _lex; }
	if (a == ',') {a = COMMA; break _lex; }

	if (a -> c == '0')
		{flags[e] = DEFF;
		do value[e] ** 1 ** 1 ** 1 + (c - '0');
			while (num(c = get()));
		putback(c); a = CON; break _lex; }

	if (c == '\'')
		{flags[e] = DEFF;
		if (strend(c = get())) {a = CON; break _lex; }
		value[e] = strc(c);

		if (strend(c = get())) {a = CON; break _lex; }
		value[e] | (strc(c) <*> 8 &~ 0377);

		if (strend(c = get())) {a = CON; break _lex; }
		putback(c); a = STRING; break _lex; }

	if (c == '[') {a = LBRAK; break _lex; }
	if (c == ']') {a = RBRAK; break _lex; }
	if (c == '(' || c == '{') {a = LPAREN; break _lex; }
	if (c == ')' || c == '}') {a = RPAREN; break _lex; }
	if (c == '"') {a = QUOTES; break _lex; }
	if (c == '\0') {a = EOF; break _lex; }

	if (c == '\\') {escape =~ escape; continue; }
	if (c == 021) {a = _debug + 1 * 1 / 3; b -> _debug; continue; }
	if (c == 001) {_line - 1; continue; }

	if (op(c))
		{d = 0;
		do if (d < NSIZE) {_name[d] = a; d + 1; }
			while (op(c = get()));
		if (d < NSIZE) _name[d] = '\0';
		putback(c);

		if (_lookup(NULL, &_name)) a -> value[e] = type[a];
		else	{_error(='illegal operator %s', _sn(&_name));
			_setvb(e, NOP, 0); a = OP; }
		break _lex; }

	if (alf(c))
		{d = 0;
		do if (d < NSIZE) {_name[d] = c; d + 1; }
			while (alf(c = get()) || num(c));
		if (d < NSIZE) _name[d] = '\0';
		putback(c);

		if (_lookup(NULL, &_name) == NULL)
			{flags[e] | DCLF;
			a = MEM; break _lex; }
		else if (escape && type[a] < KOND)
			{type[a] = MEM;
			flags[a] = 0;
			value[a] = 0;
			bias[a] = 0;
			size[a] = 2; }
		flags[e] = (b = flags[a] & ATTR);
		value[e] = a;
		size[e] = size[a];
		a = type[a]; break _lex; }

	if (num(c))
		{flags[e] = DEFF;
		do value[e] = (b = value[e] * 10 + c - '0');
			while (num(c = get()));
		putback(c); a = CON; break _lex; }

	_error(='illegal character %o', c);
    }
}	goto rretrn;

_dostring{	"args(p1)";
	call; rsave; 0;
	p1 -> e;
	_gen(d = value[e], 0);
	while (strend(c = get()) == FALSE)
		{d = strc(c);
		if (strend(c = get()))
			{_gen(d, 0); a = d; break _dostring; }
		_gen(d | (strc(c) <*> 8 &~ 0377), 0); }
		a = d;
}	goto rretrn;