// ---- 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); } xty = tbool; 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; }