aboutsummaryrefslogtreecommitdiff
path: root/src/compiler/lex.zc
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/lex.zc')
-rw-r--r--src/compiler/lex.zc652
1 files changed, 652 insertions, 0 deletions
diff --git a/src/compiler/lex.zc b/src/compiler/lex.zc
new file mode 100644
index 0000000..0b509e4
--- /dev/null
+++ b/src/compiler/lex.zc
@@ -0,0 +1,652 @@
+// ---- 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 (!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.
+int doccomment(int nl) {
+ int cl = line, start;
+ nextch();
+ if (ch == ':') { while (ch >= 0 && ch != 10) nextch(); 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;
+ }
+ 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 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(); }
+ 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;
+}
+
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-27 18:54:00 +0000