path: root/src/compiler/lex.zc

// ---- input sources ----

// frame: 0 kind (0 stdin, 1 token list, 2 string)  1 object  2 index  3 end
// 4 transparent  5..7 saved token  8..10 saved char state  11 owned  12 saved line
// 13 saved token line  14 saved lookahead count  15..30 saved lookahead  31 saved char buffer
// a backtick ends the source: it is how a program tells the compiler where its
// own text stops and the program's input begins. but only a backtick the
// lexer would read as a token counts. srcend is fed every character of a
// stdin source in order and follows just enough of the lexer's rules to know
// whether it is inside a // comment, a /* */ comment, a string or a char
// literal (a backslash escapes the next character in the last two). it
// returns 1 for a backtick outside all of them. readsrc and nextch both use
// it, so a backtick in a comment or a string is just a character.
int srcend(int c) {
	if (qst == 0) {
		if (c == 96) return 1;
		if (c == 34) qst = 3;
		else if (c == 39) qst = 4;
		else if (c == '*' && qp == '/') { qst = 2; qp = 0; return 0; }
		else if (c == '/' && qp == '/') { qst = 1; qp = 0; return 0; }
		qp = c;
		return 0;
	}
	if (qst == 1) {
		if (c == 10) { qst = 0; qp = 0; }
		return 0;
	}
	if (qst == 2) {
		if (c == '/' && qp == '*') { qst = 0; qp = 0; return 0; }
		qp = c;
		return 0;
	}
	if (qesc) { qesc = 0; return 0; }
	if (c == 92) { qesc = 1; return 0; }
	if ((qst == 3 && c == 34) || (qst == 4 && c == 39)) { qst = 0; qp = 0; }
	return 0;
}
// the character level of the lexer: ch is the current char (-1 at the end),
// and chkind says where it comes from (0 stdin, 3 a byte string, anything
// else a zero-terminated char* string). a stdin source ends at a backtick (see srcend).
int nextch() {
	if (chkind == 3) {		// the usual case: the unit readsrc packed
		ch = (chbase[chptr >> 2] >> ((chptr & 3) * 8)) & 255;
		if (ch) chptr++; else ch = -1;
	} else if (chkind == 0) {
		if (qdone || rt.eof()) { ch = -1; return 0; }
		ch = rt.get_c() & 255;
		// a read that waited for a slow pipe and found its end returns -1: that is the end, not a 0xFF byte
		if (ch == 255 && rt.eof()) { qdone = 1; ch = -1; return 0; }
		if (srcend(ch)) { qdone = 1; ch = -1; return 0; }	// a backtick ends the source
	} else {
		ch = *chptr & 255;
		if (ch) chptr++; else ch = -1;
	}
	if (ch == 10) line++;
	return 0;
}
// the place of a token travels with its line: line in the low 24 bits, then
// the length (16 bits), the offset + 1 (21 bits) and its glue (2 bits, so a
// replayed token list still tells u*x from a product)
int tpack() { return tline | (toklen << 24) | ((toff + 1) << 40) | ((tglue & 3) << 61); }
// restore the token position that tpack saved in a word.
int tunpack(int x) {
	tline = x & 0xFFFFFF;
	toklen = (x >> 24) & 0xFFFF;
	toff = ((x >> 40) & 0x1FFFFF) - 1;
	tglue = (x >> 61) & 3;
	return 0;
}
// chars consumed so far in the source being read: the index of the char in ch
// (or of the end, once the source is used up). a stdin source reports -1.
int cpos() {
	if (chkind == 3) { if (ch < 0) return chptr; return chptr - 1; }
	if (chkind == 2) { if (ch < 0) return chptr - chbase; return chptr - chbase - 1; }
	return 0 - 1;
}
// push a new input source. the current token, char state and lookahead are
// saved into a 32 word frame so src_pop can put them back exactly. kind 0 is
// stdin, 1 a token list (obj[0] is the count, then triples of kind, value and
// packed place: this is how macros, quote/grab and feed replay code), 2 a
// char* string and 3 a byte string. trans means "transparent": when a token
// list runs out the reader pops it and carries on in the source below, which
// is what lets a fed list splice into the text around it. owned means the
// frame frees obj when it pops.
int src_push(int kind, word obj, int trans, int owned) {
	word f; int i;
	isp++;
	reserve_R_SRC((isp + 1) * 32);
	f = R_SRC + isp * 32;
	f[0] = kind; f[1] = obj; f[2] = 0; f[3] = 0; f[4] = trans; f[11] = owned;
	f[5] = tk; f[6] = tv; f[7] = tglue; f[8] = ch; f[9] = chkind; f[10] = chptr;
	f[12] = line; f[13] = tpack(); f[14] = pq_n; f[31] = chbase;
	i = 0;
	while (i < pq_n) {
		f[15 + i * 4] = pq_tk[i];
		f[16 + i * 4] = pq_tv[i];
		f[17 + i * 4] = pq_gl[i];
		f[18 + i * 4] = pq_ln[i];
		i++;
	}
	pq_n = 0;
	if (kind == 1) f[3] = obj[0];
	if (kind == 0) { chkind = 0; qdone = 0; qst = 0; qp = 0; qesc = 0; line = 1; nextch(); }
	if (kind == 2) { chkind = 2; chptr = obj; chbase = obj; line = 1; nextch(); }
	if (kind == 3) { chkind = 3; chbase = obj; chptr = 0; line = 1; nextch(); }
	return 0;
}
// leave the current source and restore the one beneath it
int src_pop() {
	word f = R_SRC + isp * 32; int i = 0;
	tk = f[5]; tv = f[6]; tglue = f[7]; ch = f[8]; chkind = f[9]; chptr = f[10];
	line = f[12]; tunpack(f[13]); pq_n = f[14]; chbase = f[31];
	while (i < pq_n) {
		pq_tk[i] = f[15 + i * 4];
		pq_tv[i] = f[16 + i * 4];
		pq_gl[i] = f[17 + i * 4];
		pq_ln[i] = f[18 + i * 4];
		i++;
	}
	isp--;
	if (f[11]) rt.free(f[1]);
	f[1] = 0;	// a dead source pointer would pin a quarantined block
	return 0;
}
// the lexer's character classes. an operator is built one character at a time
// for as long as the text so far is still a prefix of some known operator
// (opprefix), so a program that adds an operator with add_binop changes how
// the next source is split into tokens without any other bookkeeping.
// the operator characters are + - * / % = < > ! & | ^ ~ ? : . @ # $ . those below
// 64 are a bit mask indexed from 33, the rest are four compares
int isopch(int c) {
	if (c < 33 || c > 126) return 0;
	if (c < 64) return (0x7a00763d >> (c - 33)) & 1;
	return c == 64 || c == 94 || c == 124 || c == 126;
}
// is buf[0..n) followed by c the start of some operator the lexer knows?
int opprefix(int n, int c) {
	int i = 0; word k; int j;
	while (i < nkop) {
		k = kops[i];
		j = 0;
		while (j < n && k[j] == tbuf[j]) j++;
		if (j == n && k[n] == c) return 1;
		i++;
	}
	return 0;
}
// true for a decimal digit.
int isdig(int c) { return c >= '0' && c <= '9'; }
// true for a letter or an underscore.
int isal(int c) { return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '_'; }
// a letter, digit or _ : the characters after the first one of a name
int isidc(int c) {
	if (c >= 'a') return c <= 'z';
	if (c >= 'A') return c <= 'Z' || c == '_';
	return c >= '0' && c <= '9';
}
// the value of a hex digit, or a value past 15 when c is not one.
int hexv(int c) {
	if (isdig(c)) return c - '0';
	if (c >= 'a' && c <= 'f') return c - 'a' + 10;
	if (c >= 'A' && c <= 'F') return c - 'A' + 10;
	return -1;
}
// one possibly escaped character of a string or char literal
int escch() {
	int c = ch;
	nextch();
	if (c != 92) return c;
	c = ch;
	nextch();
	if (c == 'n') return 10;
	if (c == 't') return 9;
	if (c == 'r') return 13;
	if (c == '0') return 0;
	if (c == 'e') return 27;
	return c;
}
// finish lexing an operator whose first n characters are in tbuf
int oplex(int n) {
	while (ch >= 0 && isopch(ch) && opprefix(n, ch)) { n = token_char(n, ch); nextch(); }
	tbuf[n] = 0;
	tk = T_OP; tv = intern(tbuf);
	return 0;
}
// per-local type flags kept in ltag. these are tiny accessors; the whole bit
// layout is: 0..3 the u/m/d tag, 4 o3, 5 float, 6 byte string, 8..10 the o3
// register, 12.. the hint bits (see LASG and friends).
// bit 5 of ltag: this local holds a float. the low bits are the u/m/d tag and bit 4 is o3.
word getflt(int i) { return (ltag[i] >> 5) & 1; }
// mark local i as holding a float, or clear the mark.
int setflt(int i, int f) {
	if (f) ltag[i] = ltag[i] | 32;
	else ltag[i] = ltag[i] - (ltag[i] & 32);
	return 0;
}
// bit 6 of ltag: this local holds a byte string. bit 5 is the float.
word getstr(int i) { return (ltag[i] >> 6) & 1; }
// mark local i as holding a string, or clear the mark.
int setstr(int i, int f) {
	if (f) ltag[i] = ltag[i] | 64;
	else ltag[i] = ltag[i] - (ltag[i] & 64);
	return 0;
}
// b"...": length word, then bytes packed 8 per word, little-endian, and a 0
// after the last byte. a jump skips the data. the address pushed is the length.
int bstrdata(char* s) {
	int a, n = 0, i = 0, w, k;
	while (s[n]) n++;
	reserve_code((n >> 3) + 2); a = here;
	emit(n);
	while (i < n) {
		w = 0; k = 0;
		while (k < 8 && i < n) { w = w | (s[i] << (k * 8)); k++; i++; }
		emit(w);
	}
	if (!(n & 7)) emit(0);
	return a;
}
int bstrlit(char* s) {
	int j = hole(), a;
	op(O_JMP); a = bstrdata(s); setlit(j, here); lit(a); return 0;
}
// ---- float literals and float code ----

// a float is one word holding the ieee bits. the lexer collects the literal's
// text in tbuf and fbits asks the core (opcode 611) to convert it, so the
// compiler needs no float parser of its own. float operations are single vm
// opcodes (OP_FADD ...). an int operand is converted on the fly, and a
// comparison leaves a plain 0/1 behind. xfloat says whether the expression
// just compiled is a float.
int fbits() { return asm { tbuf @ #1222 }; }
// collect an exponent (e+3) onto the literal in tbuf; n is the length so far
int takeexp(int n) {
	if (ch != 'e' && ch != 'E') return n;
	n = token_char(n, ch);
	nextch();
	if (ch == '+' || ch == '-') { n = token_char(n, ch); nextch(); }
	if (!isdig(ch)) { die("bad float"); return n; }
	while (isdig(ch)) { n = token_char(n, ch); nextch(); }
	return n;
}
// the literal in tbuf[0..n) is a float: hand it back as a T_FLT token
int floatok(int n) {
	tbuf[n] = 0;
	tk = T_FLT;
	tv = fbits();
	return 0;
}
// the binary operators that have a float form
int isfop(int o) {
	if (o == s_plus || o == s_minus || o == s_star || o == s_slash) return 1;
	if (o == s_lt || o == s_gt || o == s_le || o == s_ge || o == s_eqeq || o == s_ne) return 1;
	return 0;
}
// emit float arithmetic or comparison o for operands that are floats (lf, rf).
// an int left operand sits under the right one, so it is converted with
// swap / i2f / swap. > and >= are < and <= with the operands swapped, and !=
// is == followed by not.
int femit(int o, int lf, int rf) {
	if (!lf) { op(O_SWAP); op(OP_I2F); op(O_SWAP); }
	if (!rf) op(OP_I2F);
	if (o == s_plus) { op(OP_FADD); xfloat = 1; return 0; }
	if (o == s_minus) { op(OP_FSUB); xfloat = 1; return 0; }
	if (o == s_star) { op(OP_FMUL); xfloat = 1; return 0; }
	if (o == s_slash) { op(OP_FDIV); xfloat = 1; return 0; }
	if (o == s_eqeq) { op(OP_FEQ); xfloat = 0; return 0; }
	if (o == s_ne) { op(OP_FEQ); lit(1); op(18); xfloat = 0; return 0; }
	if (o == s_lt) { op(OP_FLT); xfloat = 0; return 0; }
	if (o == s_gt) { op(O_SWAP); op(OP_FLT); xfloat = 0; return 0; }
	if (o == s_le) { op(OP_FLE); xfloat = 0; return 0; }
	if (o == s_ge) { op(O_SWAP); op(OP_FLE); xfloat = 0; return 0; }
	xfloat = 0;
	return 0;
}
// true when a type is a float, the same as isfl.
word isfloat(int t) { return isfl(t); }
// float, f32, and f32's packed twin: everything computed as a double
word isfl(word t) { return t && t[0] == TY_FLOAT; }
// ±0 is false, like 0.0. every other float, including NaN, is true. the vm's
// jz stays an integer test, so a float is compared with +0 first.
int ftest() {
	if (!xfloat) return 0;
	op(OP_FLIT); emit(0); op(OP_FEQ); lit(1); op(18);
	xfloat = 0; xty = tbool;
	return 0;
}
// a float stored into an int becomes an int, and an int stored into a float
// becomes a float. word keeps the bits and drops the float mark.
int fcoerce(word dst) {
	if (dst && treadonly(xty) && isref(xty) && !treadonly(dst) && dst[0] != TY_VAR) serr("const storage cannot be converted to a mutable reference");
	vf_coerce(dst, 1);
	if (!dst || dst[0] == TY_VAR) return 0;
	if (isfl(dst)) {
		if (!xfloat) { op(OP_I2F); xfloat = 1; xty = tfloat; }
		// an f32 variable holds a value rounded to single precision; a packed
		// element is rounded when pkst stores it
		if (dst == tf32 && xty != tf32 && !ispk(xty)) { xenh("zf2s"); xenh("zs2f"); xty = tf32; }
		return 0;
	}
	if (dst[0] == TY_BOOL && xty[0] != TY_BOOL) {	// bool holds 0 or 1: any nonzero value is 1 (spec 2.1)
		if (xfloat) { op(OP_FLIT); emit(0); op(OP_FEQ); lit(1); op(18); xfloat = 0; }
		else { lit(0); op(O_PICK); lit(0); op(O_SWAP); op(O_SUB); op(17); lit(63); op(19); lit(0); op(O_SWAP); op(O_SUB); }
		if (compat(dst, xty)) xty = tbool;	// (otherwise keep the type, so a type check after this still sees it)
		return 0;
	}
	if (!xfloat) {
		if (tbytes(dst) && !samesz(dst, xty)) tnorm(dst);
		return 0;
	}
	if (isnum(dst)) { op(OP_F2I); xfloat = 0; xty = dst; if (tbytes(dst)) tnorm(dst); return 0; }
	if (dst == tword) xfloat = 0;
	return 0;
}
// sized integers. a value stored into a variable, field, parameter or array
// element of type t is cut to size first: unsigned types are masked and signed
// ones are masked and then sign-extended (xor the sign bit, subtract it).
// samesz says a value of type b is already in range for type a.
word samesz(word a, word b) { return tbytes(a) && tbytes(b) == tbytes(a) && (a[6] & 1) == (b[6] & 1); }
// narrow the integer on the stack to the width of its type.
int tnorm(word t) {
	int b = tbytes(t), s;
	if (!b || t[0] != TY_INT) return 0;
	lit((1 << (8 * b)) - 1); op(16);
	if (t[6] & 1) { s = 1 << (8 * b - 1); lit(s); op(18); lit(s); op(O_SUB); }
	return 0;
}
// [byte address] -> [value]: load a packed element of type t (the twin)
int pkld(word t) {
	int b = t[5];
	if (b == 1) op(612); else if (b == 2) op(614); else op(616);
	pkfix(t);
	return 0;
}
// a zero extended packed element on the stack becomes the value of type t
int pkfix(word t) {
	int b = t[5], s;
	if (t[0] == TY_FLOAT) { xenh("zs2f"); return 0; }	// f32: the bits widen to a double
	if (t[6] & 1) { s = 1 << (8 * b - 1); lit(s); op(18); lit(s); op(O_SUB); }
	return 0;
}
// [value byte-address] -> []: store a packed element of type t
int pkst(word t) {
	int b = t[5];
	if (t[0] == TY_FLOAT) { op(O_SWAP); xenh("zf2s"); op(O_SWAP); op(617); return 0; }	// f32: round the double to single bits
	if (b == 1) op(613); else if (b == 2) op(615); else op(617);
	return 0;
}
// an integer address and a field name: the name has to belong to one struct.
// field lookup on a bare address, for untyped code such as p.x where p is a
// plain word. if exactly one struct in the type area has a field called n, that
// is the one meant; with two or more it is ambiguous (the caller reports it).
int fieldscan(int n) {
	int i = 0; word t; int k, hit = 0;
	fldst = 0; fldi = -1;
	while (i < ntl) {
		t = typelist[i];
		if (t[0] == TY_STRUCT && t[3] >= 0) {
			k = 0;
			while (k < t[3]) {
				if (t[4][k * 3] == n) {
					if (hit) return 2;
					hit = 1; fldst = t; fldi = k;
				}
				k++;
			}
		}
		i++;
	}
	return hit;
}
// a // comment, with ch on its second slash. one that starts a line joins the
// doc comment being collected, if the line above was part of it, or starts a
// new one; a comment after code on the same line is not documentation.
// a comment //:lines NAME (ch is its colon) says that what follows is the file NAME, with its lines counted
// from the next one, and turns line tables on from the next top-level item. src/tools/automap.sh writes one
// before a program it joins to the runtime. the rest of the line is read here and the marker kept: the
// source is read once to find the signatures and again to compile, and it counts only when compiling reaches it.
int mark_line() {
	char[300] b; int n = 0, i, base; word name;
	while (ch >= 0 && ch != 10) { if (n < 298) { b[n] = ch; n++; } nextch(); }
	while (n && (b[n - 1] == 13 || b[n - 1] == 32)) n--;
	b[n] = 0;
	if (n > 7 && b[1] == 'l' && b[2] == 'i' && b[3] == 'n' && b[4] == 'e' && b[5] == 's' && b[6] == 32) {
		base = line;
		if (ch == 10) base = line - 1;
		if (!lt_nmarks || base > lt_marks[lt_nmarks * 2 - 2]) {
			if (lt_nmarks * 2 + 2 > lt_markcap) { lt_marks = chk_resize(lt_marks, lt_nmarks * 2, lt_markcap * 2 + 16); lt_markcap = lt_markcap * 2 + 16; }
			name = chk_resize(0, 0, n); i = 7;
			while (i <= n) { name[i - 7] = b[i]; i++; }
			lt_marks[lt_nmarks * 2] = base; lt_marks[lt_nmarks * 2 + 1] = name; lt_nmarks++;
		}
	}
	return 0;
}
int doccomment(int nl) {
	int cl = line, start;
	nextch();
	if (ch == ':') { mark_line(); dn = 0; dsect = 1; dlast = cl; docpending = 1; return 0; }
	if (!nl) { while (ch >= 0 && ch != 10) nextch(); return 0; }
	if (dlast != cl - 1) { dn = 0; dsect = 0; }
	if (ch == 32) nextch();
	start = dn;
	while (ch >= 0 && ch != 10) { doc_char(ch); nextch(); }
	while (dn > start && (dbuf[dn - 1] == 32 || dbuf[dn - 1] == 9 || dbuf[dn - 1] == 13)) dn--;
	// a comment block with a section heading is section text: it documents nothing
	if (dn - start >= 4 && dbuf[start] == '-' && dbuf[start + 1] == '-' && dbuf[dn - 1] == '-' && dbuf[dn - 2] == '-') dsect = 1;
	if (dsect) { dn = 0; dlast = cl; docpending = 1; return 0; }
	doc_char(10);
	dlast = cl; docpending = 1;
	return 0;
}
// block documentation can end on the declaration's line. remove the optional
// leading star on each line, while leaving markdown inside the comment intact.
int docblock(int nl) {
	int cl = line, bol = 1, c, adj = dsect && dlast == cl - 1;
	if (!nl || (dn && dlast != cl - 1)) dn = 0;
	if (!adj) dsect = 0;
	nextch();
	if (ch == '*') { nextch(); if (ch == '/') { nextch(); return 0; } }
	while (ch >= 0) {
		if (bol) {
			while (ch == 32 || ch == 9) nextch();
			if (ch == '*') { nextch(); if (ch == '/') { cl = line; nextch(); break; } if (ch == 32) nextch(); }
			bol = 0;
		}
		c = ch; nextch();
		if (c == '*' && ch == '/') { cl = line; nextch(); break; }
		doc_char(c);
		if (c == 10) bol = 1;
	}
	if (ch < 0) { tline = line; serr("unterminated comment"); }
	while (dn && (dbuf[dn - 1] == 32 || dbuf[dn - 1] == 9 || dbuf[dn - 1] == 10 || dbuf[dn - 1] == 13)) dn--;
	doc_char(10); dlast = cl; docpending = 1;
	if (adj) dn = 0;
	return 0;
}
// the lexer proper: skip white space and comments, then read one token into
// tk / tv with its place in tline / toff. numbers (decimal, hex, floats),
// names, char and string literals (b"..." is a byte string), and operators
// all start here. tglue is 1 when the token touches the one before it with no
// white space, 0 when it does not, and 3 for a char literal (so the magic
// number hint can leave 'a' alone). asm blocks use it to read -5 as one
// literal.
// commented numeric literals are recorded by source offset, including lookahead.
word literal_docs; int literal_doc_n, literal_doc_cap = 32, token_block_doc;
int literal_documented(int off) {
	int key = off + 1, i;
	if (!literal_doc_n || key <= 0) return 0;
	i = dg_hash(key, literal_doc_cap);
	while (literal_docs[i]) { if (literal_docs[i] == key) return 1; i = (i + 1) & (literal_doc_cap - 1); }
	return 0;
}
int literal_doc_note(int off) {
	int key = off + 1, i, cap, k; word old;
	if (literal_documented(off)) return 0;
	if (!literal_docs) literal_docs = chk_resize(0, 0, literal_doc_cap);
	if ((literal_doc_n + 1) * 2 >= literal_doc_cap) {
		old = literal_docs; cap = literal_doc_cap * 2; literal_docs = chk_resize(0, 0, cap);
		i = 0;
		while (i < literal_doc_cap) { if (old[i]) { k = dg_hash(old[i], cap); while (literal_docs[k]) k = (k + 1) & (cap - 1); literal_docs[k] = old[i]; } i++; }
		literal_doc_cap = cap;
	}
	i = dg_hash(key, literal_doc_cap); while (literal_docs[i]) i = (i + 1) & (literal_doc_cap - 1);
	literal_docs[i] = key; literal_doc_n++; return 0;
}
int lex1() {
	int n = 0, v, dg, nl;
	token_block_doc = 0;
	if (pendot) {
		pendot = 0; tglue = 1; tline = line; toff = cpos();
		tbuf[0] = '.'; tbuf[1] = 0; tk = T_OP; tv = intern(tbuf);
		return 0;
	}
	tglue = 1;
	nl = tline != line;
	while (1) {
		while (ch == 32 || ch == 9 || ch == 10 || ch == 13) { if (ch == 10) nl = 1; nextch(); tglue = 0; }
		if (ch != '/') break;
		nextch();
		if (ch == '/') {
			if (docs_on) doccomment(nl);
			else {
				nextch();
				if (ch == ':') mark_line(); else while (ch >= 0 && ch != 10) nextch();
			}
			tglue = 0; continue;
		}
		if (ch == '*') {
			token_block_doc = 1;
			if (docs_on) { docblock(nl); tglue = 0; continue; }
			nextch();
			while (ch >= 0) { if (ch == '*') { nextch(); if (ch == '/') break; } else nextch(); }
			if (ch < 0) { tline = line; serr("unterminated comment"); }	// a /* with no */ (spec 1.2.2)
			nextch(); tglue = 0; continue;
		}
		tline = line; toff = cpos() - 1; tbuf[0] = '/'; oplex(1); return 0;
	}
	tline = line; toff = cpos();
	if (docpending) {
		dline = 0;
		if (dn && (tline == dlast || tline == dlast + 1)) dline = tline;
		docpending = 0;
	}
	if (ch < 0) { tk = T_EOF; tv = 0; return 0; }
	if (isdig(ch)) {
		v = 0; n = 0;
		if (ch == '0') {
			nextch();
			if (ch == 'x' || ch == 'X') {
				nextch();
				while ((dg = hexv(ch)) >= 0) { v = v * 16 + dg; nextch(); }
				tk = T_NUM; tv = v; return 0;
			}
			tbuf[0] = '0'; n = 1;
		}
		while (isdig(ch)) { n = token_char(n, ch); v = v * 10 + ch - '0'; nextch(); }
		if (ch == 'e' || ch == 'E') { n = takeexp(n); return floatok(n); }
		if (ch == '.') {
			nextch();
			if (isdig(ch) || ch == 'e' || ch == 'E') {
				n = token_char(n, '.');
				while (isdig(ch)) { n = token_char(n, ch); nextch(); }
				return floatok(takeexp(n));
			}
			if (isal(ch)) { pendot = 1; tk = T_NUM; tv = v; return 0; }	// 1.field
			n = token_char(n, '.');
			return floatok(n);
		}
		tk = T_NUM; tv = v; return 0;
	}
	if (isal(ch)) {
		while (isidc(ch)) { n = token_char(n, ch); nextch(); }
		tbuf[n] = 0;
		if (n == 1 && tbuf[0] == 'b' && ch == 34) {
			n = 0; nextch();
			while (ch >= 0 && ch != 34) { v = escch(); n = token_char(n, v); }
			nextch();
			tbuf[n] = 0;
			tk = T_BSTR; tv = intern(tbuf); return 0;
		}
		if (ch == '.' && module_known(tbuf) && findloc(intern(tbuf)) < 0) {
			n = token_char(n, '.'); nextch();
			while (isidc(ch)) { n = token_char(n, ch); nextch(); }
			tbuf[n] = 0;
		}
		tk = T_ID; tv = intern(tbuf); return 0;
	}
	if (ch == 39) {
		nextch();
		tv = escch();
		if (ch != 39) die("bad character literal");
		nextch();
		tk = T_NUM;
		tglue = 3;
		return 0;
	}
	if (ch == 34) {
		nextch();
		while (ch >= 0 && ch != 34) { v = escch(); n = token_char(n, v); }
		nextch();
		tbuf[n] = 0;
		tk = T_STR; tv = intern(tbuf); return 0;
	}
	if (ch == '.') {
		nextch();
		if (isdig(ch)) {
			n = 0; tbuf[0] = '.'; n = 1;
			while (isdig(ch)) { n = token_char(n, ch); nextch(); }
			return floatok(takeexp(n));
		}
		tbuf[0] = '.';
		if (isopch(ch) && opprefix(1, ch)) return oplex(1);
		tbuf[1] = 0;
		tk = T_OP; tv = intern(tbuf);
		return 0;
	}
	tbuf[0] = ch;
	nextch();
	if (isopch(tbuf[0])) return oplex(1);
	tbuf[1] = 0;
	tk = T_OP; tv = intern(tbuf);
	return 0;
}
// lex1 plus the token's length, so the language server knows its extent
int lex() {
	lex1();
	if (cmode && tk == T_NUM && token_block_doc && chkind == 3 && chbase == rsbase && toff >= 0) {
		literal_doc_note(toff);
	}
	if (toff < 0) toklen = 0; else toklen = cpos() - toff;
	return 0;
}
// one token of lookahead: peek() fills pk_*, next() takes it first
int next() {
	int i = 1;
	ntok++;
	if (toff >= 0) { tpend = toff + toklen; tpline = tline; }
	if (pq_n) {
		tk = pq_tk[0]; tv = pq_tv[0]; tglue = pq_gl[0]; tunpack(pq_ln[0]);
		while (i < pq_n) {
			pq_tk[i - 1] = pq_tk[i];
			pq_tv[i - 1] = pq_tv[i];
			pq_gl[i - 1] = pq_gl[i];
			pq_ln[i - 1] = pq_ln[i];
			i++;
		}
		pq_n--;
		if (grec) grec_add();
		return 0;
	}
	next0();
	if (grec) grec_add();
	return 0;
}
// the k-th token after the current one (k from 0 to 3), into pk_tk and pk_tv
int peekat(int k) {
	int a, b, c, e;
	while (pq_n <= k) {
		a = tk; b = tv; c = tglue; e = tpack();
		next0();
		pq_tk[pq_n] = tk; pq_tv[pq_n] = tv; pq_gl[pq_n] = tglue; pq_ln[pq_n] = tpack(); pq_n++;
		tk = a; tv = b; tglue = c; tunpack(e);
	}
	pk_tk = pq_tk[k]; pk_tv = pq_tv[k];
	return 0;
}
// look at the next token without consuming it.
int peek() { return peekat(0); }
// the lowest level of "next token": from a token list if one is the current
// source, otherwise from the lexer. in check mode after an abort it returns
// end of file forever, which unwinds every parsing loop without any special
// case in them.
int next0() {
	word f, q; int i;
	if (chkabort) { tk = T_EOF; tv = 0; chkfuel++; if (chkfuel > 3000000) rt.halt(); return 0; }
	f = R_SRC + isp * 32;
	if (f[0] != 1) { lex(); return 0; }
	i = f[2];
	if (i < f[3]) {
		q = f[1];
		tk = q[1 + i * 3];
		tv = q[2 + i * 3];
		tunpack(q[3 + i * 3]);
		f[2] = i + 1;
		return 0;
	}
	if (!f[4]) { tk = T_EOF; tv = 0; return 0; }
	src_pop();		// a fed list ran out: continue with the token that followed it
	return 0;
}
// token tests. s is an interned spelling, so these are pointer compares.
int is_op(int s) { return tk == T_OP && tv == s; }
// true when the current token is the name s.
int is_id(int s) { return tk == T_ID && tv == s; }
// consume the current token if it is the operator or name s, and say whether it did.
int accept(int s) {
	if ((tk == T_OP || tk == T_ID) && tv == s) { next(); return 1; }
	return 0;
}
// accept(s) consumes the token if it is s. expect reports "expected s" at the
// end of the previous token (dgprev) when it is missing, and goes into panic.
int expect(int s) {
	if (!accept(s)) {
		if (!panic && !dry) {
			dgprev = 1;
			errat();
			dgprev = 0;
			rt.put_s("expected '"); rt.put_s(s); rt.put_s("', found "); tokshow();
			errend();
		}
		panic = 1;
		if (tk == T_EOF) giveup();
	}
	return 0;
}
// read an identifier and return its interned handle
int name() {
	int n = tv;
	if (tk != T_ID) diefound("expected a name");
	nameoff = toff;
	next();
	return n;
}