aboutsummaryrefslogtreecommitdiff
path: root/src/compiler/builtins.zc
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/builtins.zc')
-rw-r--r--src/compiler/builtins.zc1423
1 files changed, 1423 insertions, 0 deletions
diff --git a/src/compiler/builtins.zc b/src/compiler/builtins.zc
new file mode 100644
index 0000000..53d8597
--- /dev/null
+++ b/src/compiler/builtins.zc
@@ -0,0 +1,1423 @@
+// memdebug on; checks and interior pinning. memdebug scrub; also poisons frees.
+// memdebug off; stops both. at the top level, start() applies it before main.
+// ---- statements that only configure the compiler ----
+
+int kw_memdebug() {
+ int f = 0;
+ stmtonly();
+ next();
+ if (is_id(s_on)) { mdbg = 1; f = 5; }
+ else if (is_id(s_scrub)) { mdbg = 1; f = 7; }
+ else if (is_id(s_off)) { mdbg = 0; f = 0; }
+ else die("memdebug on, memdebug scrub or memdebug off");
+ next();
+ expect(s_semi);
+ if (infn) { lit(f); callname(s_memset); op(O_DROP); }
+ else mdbg_flags = f;
+ return 0;
+}
+// enum name { A, B = 5, C }; the names are global constants, the name is an int type
+// the type of an enum: an int record that the typechecker keeps apart from the
+// plain ints. t[6] bit 4 marks it; the members carry it in stype
+word tenum(char* n) { word t = tnew(TY_INT, 1, n, 0); t[6] = 16; return t; }
+// true for a type made by an enum declaration.
+word isen(word t) { return t[0] == TY_INT && (t[6] & 16); }
+// enum name { A, B = 5 }: each member is a constant, plain (A) and scoped (name.A)
+// member records for tagged enums and for plain enums (pm_en is -1 for a plain
+// member). a member's payload fields are at most 8.
+// the text a tagged enum or an extern stub is generated into
+char[GENERATED_WORDS] ebuf_initial; char* ebuf = ebuf_initial; int ebcap = GENERATED_WORDS, ebn;
+char*[ENUM_MEMBERS] pm_name_initial, pm_en_initial; word[ENUM_MEMBERS] pm_tag_initial, pm_nf_initial, pm_val_initial, pm_exp_initial;
+char** pm_name = pm_name_initial, pm_en = pm_en_initial; word pm_tag = pm_tag_initial, pm_nf = pm_nf_initial, pm_val = pm_val_initial, pm_exp = pm_exp_initial; int pmcap = ENUM_MEMBERS, npm;
+char*[ENUM_MEMBERS * 8] pm_fnm_initial; word[ENUM_MEMBERS * 8] pm_ft_initial, pm_off_initial;
+char** pm_fnm = pm_fnm_initial; word pm_ft = pm_ft_initial, pm_off = pm_off_initial;
+word[TAGGED_ENUMS] pe_st_initial, pe_first_initial, pe_n_initial; char*[TAGGED_ENUMS] pe_name_initial;
+word pe_st = pe_st_initial, pe_first = pe_first_initial, pe_n = pe_n_initial; char** pe_name = pe_name_initial; int pecap = TAGGED_ENUMS, npe;
+// grow whole member rows, keeping their payload-field indices stable.
+int reserve_enum_members(int need) {
+ int cap = pmcap;
+ if (need <= cap) return cap;
+ while (cap < need) cap = cap * 2;
+ pm_name = chk_resize(pm_name, npm, cap); pm_en = chk_resize(pm_en, npm, cap);
+ pm_tag = chk_resize(pm_tag, npm, cap); pm_nf = chk_resize(pm_nf, npm, cap);
+ pm_val = chk_resize(pm_val, npm, cap); pm_exp = chk_resize(pm_exp, npm, cap);
+ pm_fnm = chk_resize(pm_fnm, npm * 8, cap * 8); pm_ft = chk_resize(pm_ft, npm * 8, cap * 8); pm_off = chk_resize(pm_off, npm * 8, cap * 8);
+ pmcap = cap; return cap;
+}
+// grow the tagged-enum index independently of its member rows.
+int reserve_tagged_enums(int need) {
+ int cap = pecap;
+ if (need <= cap) return cap;
+ while (cap < need) cap = cap * 2;
+ pe_st = chk_resize(pe_st, npe, cap); pe_first = chk_resize(pe_first, npe, cap);
+ pe_n = chk_resize(pe_n, npe, cap); pe_name = chk_resize(pe_name, npe, cap);
+ pecap = cap; return cap;
+}
+// a field's c-like spelling in a generated struct
+char* ftext(int t) { if (t == tint) return "int"; if (t == tfloat) return "float"; return "let"; }
+// the member named n of a tagged enum, or -1
+int pm_find(char* n) {
+ int gi = npm - 1;
+ while (gi >= 0) { if (pm_name[gi] == n && pm_en[gi] >= 0) return gi; gi--; }
+ return -1;
+}
+// the tagged enum a type is a pointer to, plus one; 0 for any other type
+int ptagged(word t) {
+ int e = 0;
+ if (!t || t[0] != TY_PTR) return 0;
+ while (e < npe) { if (t[4] == pe_st[e]) return e + 1; e++; }
+ return 0;
+}
+// enum name { A, B = 5 } is a plain enum: each member is a constant, plain (A)
+// and scoped (name.A). a member with a block of fields makes it a tagged enum
+// (see enum_tagged): enum name { circle { int r; }, dot }.
+int kw_enum() {
+ char* n; char* en = 0; int first = npm, cnt = 0, tagged = 0, gi, nf, v = 0, et = 0, sk, ft; char* fname;
+ stmtonly();
+ next();
+ if (tk == T_ID) { en = tv; next(); }
+ expect(s_lb);
+ while (!is_op(s_rb)) {
+ if (tk == T_EOF) { die("missing }"); break; }
+ reserve_enum_members(npm + 1);
+ gi = npm; npm++;
+ n = name();
+ pm_name[gi] = n; pm_tag[gi] = cnt; pm_nf[gi] = 0; pm_en[gi] = -1; pm_val[gi] = 0; pm_exp[gi] = 0;
+ if (is_op(s_lb)) {
+ tagged = 1; next();
+ while (!is_op(s_rb)) {
+ if (tk == T_EOF) { die("missing }"); break; }
+ if (pm_nf[gi] >= 8) { fatal("too many fields in a member"); break; }
+ if (is_id(s_var)) { next(); ft = tword; }
+ else { rettype(); ft = dty; if (dtag) serr("a payload field has no tag"); }
+ if (ft != tint && ft != tfloat && ft != tword) serr("a payload field is int, float or let");
+ fname = name();
+ nf = gi * 8 + pm_nf[gi];
+ pm_fnm[nf] = fname; pm_ft[nf] = ft; pm_nf[gi]++;
+ expect(s_semi);
+ }
+ expect(s_rb);
+ } else if (accept(s_eq)) { pm_val[gi] = cexpr(); pm_exp[gi] = 1; }
+ cnt++;
+ if (!accept(s_comma)) break;
+ if (is_op(s_rb)) break;
+ }
+ expect(s_rb);
+ expect(s_semi);
+ if (tagged) return enum_tagged(en, first, cnt);
+ if (en) { et = tenum(en); addsym(en, K_TYPE, et); }
+ for (gi = first; gi < npm; gi++) {
+ if (pm_exp[gi]) v = pm_val[gi];
+ sk = addsym(pm_name[gi], K_CONST, v);
+ stype[sk] = et;
+ if (en) { sk = addsym(methname(en, pm_name[gi]), K_CONST, v); stype[sk] = et; }
+ v++;
+ }
+ return 0;
+}
+// a tagged enum: one struct, with the tag as word 0 and the fields of every
+// member after it, each named member_field. a member's constructor is a static
+// function on the enum, en.member(fields...), that allocates the struct, sets
+// the tag and the member's fields, and returns it owned. the struct is generated
+// as source and compiled here, so its methods are ordinary zc.
+int enum_tagged(char* en, int first, int cnt) {
+ int gi, j, nf, w = 1; word buf, oldimports = module_imports; int sk;
+ if (!en) { serr("a tagged enum needs a name"); return 0; }
+ reserve_tagged_enums(npe + 1);
+ if (cnt > 63) { fatal("a tagged enum has at most 63 members"); return 0; }
+ for (gi = first; gi < npm; gi++) if (pm_exp[gi]) serr("a tagged enum's members take no explicit values");
+ ebn = 0; ebuf[0] = 0;
+ ebs("struct "); ebs(en); ebs(" { int tag; ");
+ for (gi = first; gi < npm; gi++) {
+ for (j = 0; j < pm_nf[gi]; j++) {
+ nf = gi * 8 + j;
+ pm_off[nf] = w; w++;
+ ebs(ftext(pm_ft[nf])); ebs(" "); ebs(pm_name[gi]); ebs("_"); ebs(pm_fnm[nf]); ebs("; ");
+ }
+ }
+ for (gi = first; gi < npm; gi++) {
+ ebs("static "); ebs(en); ebs("*.u "); ebs(pm_name[gi]); ebs("(");
+ for (j = 0; j < pm_nf[gi]; j++) {
+ nf = gi * 8 + j;
+ if (j) ebs(", ");
+ if (pm_ft[nf] == tint) ebs("int "); else if (pm_ft[nf] == tfloat) ebs("float ");
+ ebs(pm_fnm[nf]);
+ }
+ ebs(") { "); ebs(en); ebs("* o = rt.new("); ebs(en); ebs("); o.tag = "); ebn10(pm_tag[gi]); ebs("; ");
+ for (j = 0; j < pm_nf[gi]; j++) {
+ nf = gi * 8 + j;
+ ebs("o."); ebs(pm_name[gi]); ebs("_"); ebs(pm_fnm[nf]); ebs(" = "); ebs(pm_fnm[nf]); ebs("; ");
+ }
+ ebs("return u*o; } ");
+ }
+ ebs("}");
+ buf = rt.new(ebn + 14);
+ rt.copy_w(buf, "include rt; ", 12);
+ rt.copy_w(buf + 12, ebuf, ebn + 1);
+ src_push(2, buf, 0, 0);
+ next();
+ stubgen = 1;
+ while (tk != T_EOF) topitem();
+ stubgen = 0;
+ src_pop();
+ module_imports = oldimports;
+ rt.free(d*buf);
+ sk = lookup(en);
+ if (sk < 0 || skind[sk] != K_TYPE) { serr("the tagged enum didn't make its struct"); return 0; }
+ pe_st[npe] = sval[sk]; pe_first[npe] = first; pe_n[npe] = cnt; pe_name[npe] = en;
+ for (gi = first; gi < npm; gi++) {
+ pm_en[gi] = npe;
+ sk = addsym(pm_name[gi], K_CONST, pm_tag[gi]);
+ stype[sk] = 0;
+ }
+ npe++;
+ return 0;
+}
+// a switch over a tagged enum that leaves out a member, with no default, is a
+// warning, on the line of the switch (sl). e is the enum, cov the bit set of
+// the tags the switch covers.
+int cover_warn(int e, int cov, int sl) {
+ int k, gi, first = 1;
+ if (dry || panic || cmode) return 0;
+ for (k = 0; k < pe_n[e]; k++) {
+ if (k < 63 && ((cov >> k) & 1)) continue;
+ if (first) { rt.put_s("zc: line "); rt.put_n(sl); rt.put_s(": warning: this switch doesn't cover "); first = 0; }
+ else rt.put_s(", ");
+ gi = pe_first[e] + k;
+ rt.put_s(pm_name[gi]);
+ }
+ if (!first) rt.put_c(10);
+ return 0;
+}
+// ---- include ----
+
+// the text of an embedded library, one character to a word and ending in 0, as readfile gives a file.
+// it is unpacked from the byte string the first time it is asked for.
+char* bstr_text(bstr p) {
+ int n = rt.len_s(p), i = 0; char* b = m*rt.new(n + 2);
+ while (i < n) { b[i] = rt.at_s(p, i); i++; }
+ b[n] = 0;
+ return b;
+}
+// the embedded std module.
+char* std_text() {
+ if (!std_buf) std_buf = bstr_text(std_source());
+ return std_buf;
+}
+// the embedded icon module.
+char* icon_text() {
+ if (!icon_buf) icon_buf = bstr_text(icon_source());
+ return icon_buf;
+}
+// a path with its . and .. segments and doubled slashes taken out: /a/b/../c/./d.zc is /a/c/d.zc
+char*.u inc_norm(char*.m p) {
+ int n = rt.len_w(p), i = 0, k = 0, s, e, j, isabs = 0; char* o;
+ o = rt.new(n + 4);
+ if (p[0] == '/') isabs = 1;
+ while (i < n) {
+ while (i < n && p[i] == '/') i++;
+ s = i;
+ while (i < n && p[i] != '/') i++;
+ e = i;
+ if (e == s) continue;
+ if (e - s == 1 && p[s] == '.') continue;
+ if (e - s == 2 && p[s] == '.' && p[s + 1] == '.') {
+ j = k;
+ while (j > 0 && o[j - 1] != '/') j--;
+ // the last segment is o[j..k); a leading .. of a relative path stays
+ if (k > 0 && !(k - j == 2 && o[j] == '.' && o[j + 1] == '.')) {
+ if (j > 0) k = j - 1; else k = 0;
+ continue;
+ }
+ if (k == 0 && isabs) continue;
+ }
+ if (k > 0 || isabs) { o[k] = '/'; k++; }
+ j = s; while (j < e) { o[k] = p[j]; k++; j++; }
+ }
+ if (k == 0 && isabs) { o[0] = '/'; k = 1; }
+ o[k] = 0;
+ return o;
+}
+// dir, a slash and path
+char*.u inc_cat(char*.m dir, char*.m path) {
+ int a = rt.len_w(dir), b = rt.len_w(path); char* o;
+ o = rt.new(a + b + 3);
+ rt.copy_w(o, dir, a);
+ o[a] = '/';
+ rt.copy_w(o + a + 1, path, b);
+ o[a + b + 1] = 0;
+ return o;
+}
+// the directory part of a path, without the last slash, or 0 when there is none
+char*.u inc_dir(char*.m p) {
+ int n = rt.len_w(p), k; char* o;
+ k = n;
+ while (k > 0 && p[k - 1] != '/') k--;
+ if (k == 0) return 0;
+ if (k > 1) k--;
+ o = rt.new(k + 2);
+ rt.copy_w(o, p, k);
+ o[k] = 0;
+ return o;
+}
+// the text of the file at path: the editor's copy if it sent one, else the file
+char*.u inc_try(char*.m path) {
+ if (inc_hook) {
+ char* text = inc_hook(path);
+ if (text) {
+ int n = rt.len_w(text); char* copy = rt.new(n + 1);
+ rt.copy_w(copy, text, n + 1); return copy;
+ }
+ }
+ char* copy = rt.readfile(path);
+ return copy;
+}
+// find an include: next to the file that has it, then in the workspace folder, then as written (relative to the
+// working directory). incres is where it was found
+char*.u inc_open(char*.m path) {
+ incres = inc_norm(path);
+ if (path[0] == '/' || path[1] == ':') {
+ char* c = inc_norm(path), b = inc_try(c);
+ if (b) incres = c;
+ return b;
+ }
+ if (incdir) {
+ char* combined = inc_cat(incdir, path); char* c = inc_norm(combined), b = inc_try(c);
+ if (b) { incres = c; return b; }
+ }
+ if (increoot) {
+ char* combined = inc_cat(increoot, path); char* c = inc_norm(combined), b = inc_try(c);
+ if (b) { incres = c; return b; }
+ }
+ return inc_try(path);
+}
+// compile the text buf as if it were written here, signatures first. name is what hovers and definitions call it
+// and dir the directory its own includes are found from
+int inc_compile(char* buf, char* name, char*.d dir) {
+ char* oldname = curinc; word olddir = incdir;
+ char* oldmodule = module_name; word oldimports = module_imports;
+ module_imports = 0; module_name = 0;
+ prescan(2, buf);
+ src_push(2, buf, 0, 0);
+ curinc = name; incdir = dir; incdepth++;
+ next();
+ while (tk != T_EOF) topitem();
+ curinc = oldname; incdir = olddir; incdepth--;
+ src_pop();
+ module_name = oldmodule; module_imports = oldimports;
+ return 0;
+}
+// include "path"; reads the file and compiles it here, signatures first
+// include std; does the same with the standard library, which is part of the compiler
+int kw_include() {
+ int pp, sv; char* path; char* buf;
+ stmtonly();
+ next();
+ if (tk == T_ID) {
+ while (1) {
+ pp = tpack(); path = tv;
+ if (tk != T_ID) { die("expected a module name in include"); return 0; }
+ next();
+ if (!module_imported(path)) {
+ word link = chk_resize(0, 0, 2); link[0] = module_imports; link[1] = path; module_imports = link;
+ }
+ if (path == s_std && !std_done) {
+ std_done = 1; if (incdepth == 0) incplace = pp;
+ inc_compile(std_text(), "tinyvm:std.zc", 0);
+ }
+ if (path == s_icon && !icon_done) {
+ icon_done = 1; if (incdepth == 0) incplace = pp;
+ inc_compile(icon_text(), "tinyvm:icon.zc", 0);
+ }
+ if (!module_known(path) && !module_loaded(path)) {
+ char* filename = inc_cat("src/lib", path); int length = rt.len_w(filename);
+ char* full = chk_resize(0, 0, length + 4); rt.copy_w(full, filename, length); rt.copy_w(full + length, ".zc", 4);
+ buf = m*inc_open(full);
+ if (!buf) { sv = tpack(); tunpack(pp); serr("can't read that module include"); tunpack(sv); return 0; }
+ word link = chk_resize(0, 0, 2); link[0] = included_modules; link[1] = path; included_modules = link;
+ if (incdepth == 0) incplace = pp;
+ inc_compile(buf, incres, inc_dir(incres));
+ }
+ if (!accept(s_comma)) break;
+ }
+ expect(s_semi); return 0;
+ }
+ if (tk != T_STR) { die("include takes a path in quotes, or std"); return 0; }
+ pp = tpack();
+ path = tv;
+ next();
+ expect(s_semi);
+ buf = m*inc_open(path);
+ if (!buf) {
+ sv = tpack(); tunpack(pp);
+ serr("can't read that include");
+ tunpack(sv);
+ return 0;
+ }
+ if (incdepth == 0) incplace = pp;
+ inc_compile(buf, incres, inc_dir(incres));
+ return 0;
+}
+// embed "path" as [type] name; declares name with the bytes of the file at path, read
+// when the unit is compiled. the path is found the way an include's is. with no type, or
+// bstr, name is a byte string of the file; char* gives one character to a word; a number
+// type takes the bytes little-endian (a float or f32 needs exactly its size); T[] and
+// T[n] lay the bytes out as the array's elements, packed for the sized types, one byte
+// to an element for char[]. at the top level name is a global, in a function a local.
+int kw_embed() {
+ int pp, off, n, t = 0, i, w, count, k, a, j, v, sz, skip = -1; char* path; word data;
+ stmtonly();
+ next();
+ pp = tpack();
+ if (tk != T_STR) { die("embed takes a path in quotes: embed \"file\" as name;"); return 0; }
+ path = tv; next();
+ if (!is_id(s_as)) { die("expected as: embed \"file\" as [type] name;"); return 0; }
+ next();
+ peekat(0);
+ if (!(tk == T_ID && pk_tk == T_OP && pk_tv == s_semi)) t = ptype();
+ off = toff; n = name();
+ expect(s_semi);
+ data = m*embed_open(path);
+ if (!data) { embed_fail(pp, "can't read the file named by embed"); data = chk_resize(0, 0, 1); }
+ sz = data[0];
+ if (!t) t = tbstr;
+ // in a function the data sits in the code stream, so the code jumps over it
+ if (infn && (t == tbstr || t == tptr(tchar) || t[0] == TY_ARR)) { reserve_code(2); skip = hole(); op(O_JMP); }
+ if (t == tbstr || t == tptr(tchar)) {
+ if (t == tbstr) { a = embed_bstr(data); }
+ else { reserve_code(sz + 1); a = here; i = 0; while (i < sz) { emit(data[1 + i]); i++; } emit(0); }
+ if (skip >= 0) setlit(skip, here);
+ return embed_bind(n, off, t, a, 0);
+ }
+ if (t[0] == TY_ARR) {
+ w = embed_width(t[4]);
+ if (!w) { embed_fail(pp, "embed declares a bstr, a char*, a number, or an array of numbers"); if (skip >= 0) setlit(skip, here); return embed_bind(n, off, tword, 0, 2); }
+ if (sz % w) { embed_fail(pp, "the embedded file's size is not a whole number of array elements"); if (skip >= 0) setlit(skip, here); return embed_bind(n, off, tword, 0, 2); }
+ count = sz / w;
+ if (t[3] >= 0 && count > t[3]) { embed_fail(pp, "the embedded file is larger than the array it is declared as"); if (skip >= 0) setlit(skip, here); return embed_bind(n, off, tword, 0, 2); }
+ if (t[3] < 0) t = tarr(t[4], count);
+ k = tsz(t); reserve_code(k); a = here; i = 0;
+ if (t[4][0] == TY_CHAR) { while (i < k) { if (i < sz) emit(data[1 + i]); else emit(0); i++; } }
+ else {
+ while (i < k) {
+ v = 0; j = 0;
+ while (j < 8) { if (i * 8 + j < sz) v = v | (data[1 + i * 8 + j] << (j * 8)); j++; }
+ emit(v); i++;
+ }
+ }
+ if (skip >= 0) setlit(skip, here);
+ return embed_bind(n, off, t, a, 1);
+ }
+ w = embed_width(t);
+ if (!w) { embed_fail(pp, "embed declares a bstr, a char*, a number, or an array of numbers"); return embed_bind(n, off, tword, 0, 2); }
+ if (sz > w) { embed_fail(pp, "the embedded file is larger than the type it is declared as"); return embed_bind(n, off, tword, 0, 2); }
+ if (isfl(t) && sz != w) { embed_fail(pp, "an embedded float takes exactly as many bytes as its type"); return embed_bind(n, off, tword, 0, 2); }
+ v = 0; i = 0;
+ while (i < sz) { v = v | (data[1 + i] << (i * 8)); i++; }
+ if (isfl(t) && w == 4) v = rt.s2f(v);
+ else v = cnorm(t, v);
+ return embed_bind(n, off, t, v, 2);
+}
+// report msg at the embed declaration that starts at the token packed in pp. the
+// caller still declares the name, as a plain 0, so its uses are not reported too.
+int embed_fail(int pp, char* msg) {
+ int sv = tpack();
+ tunpack(pp); serr(msg); tunpack(sv);
+ return 0;
+}
+// the bytes one element of type t takes in an embedded file: the packed size of a
+// sized type or f32, 1 for char, 8 for the other number types, 0 when t is not a number.
+int embed_width(word t) {
+ if (tbytes(t)) return tbytes(t);
+ if (t[0] == TY_CHAR) return 1;
+ if (t[0] == TY_INT || t[0] == TY_WORD || t[0] == TY_BOOL || t[0] == TY_FLOAT) return 8;
+ return 0;
+}
+// the bytes of block data ([n, b0, b1, ...]) as byte string storage in the code stream.
+int embed_bstr(word data) {
+ int n = data[0], a, i = 0, w, k;
+ reserve_code((n >> 3) + 2); a = here;
+ emit(n);
+ while (i < n) {
+ w = 0; k = 0;
+ while (k < 8 && i < n) { w = w | (data[1 + i] << (k * 8)); k++; i++; }
+ emit(w);
+ }
+ if (!(n & 7)) emit(0);
+ return a;
+}
+// declare name of type t. kind 0: a is the address of the data, which becomes the value;
+// kind 1: a is an array's storage; kind 2: a is the value itself. a global keeps the
+// value in its slot; a local is initialized from it, and a local array copies the storage.
+int embed_bind(int n, int off, word t, int a, int kind) {
+ int s, i;
+ if (!infn) {
+ if (kind == 1) { s = addsym(n, K_GARR, a); }
+ else { reserve_code(1); s = addsym(n, K_GVAR, here); emit(a); }
+ rs_put(off, RS_SYM, rs_sym(s), s); stype[s] = t;
+ lt_note(off, t);
+ return 0;
+ }
+ i = newloc(n); lrsoff[i] = off; rs_note(RS_LOCAL, off);
+ ltag[i] = LDECL; lpos[i] = tpack(); lnsz[i] = 0; lleaf[i] = 0; ltype[i] = t;
+ if (kind == 1) {
+ larr[i] = 1; fslots = fslots + tsz(t); capture_cell(i, 0);
+ vaddr(i); lit(a); lit(tsz(t)); callname(s_copy_w); op(O_DROP);
+ } else {
+ fslots++; if (isfl(t)) setflt(i, 1); capture_cell(i, 0);
+ lit(a); vaddr(i); op(O_ST);
+ setstr(i, t == tbstr);
+ }
+ lt_note(off, t);
+ return 0;
+}
+// the bytes of an embedded file as [n, b0, b1, ...], found next to the including file,
+// then in the workspace folder, then as written, like an include. 0 when none opens.
+word.u embed_open(char*.m path) {
+ if (path[0] != '/' && incdir) { char* combined = inc_cat(incdir, path); char* c = inc_norm(combined); word b = rt.readbytes(c); if (b) return b; }
+ if (path[0] != '/' && increoot) { char* combined = inc_cat(increoot, path); char* c = inc_norm(combined); word b = rt.readbytes(c); if (b) return b; }
+ word b = rt.readbytes(path);
+ return b;
+}
+// file namespace and imports are restored when an included source ends.
+int kw_namespace() {
+ next();
+ if (is_op(s_semi)) module_name = 0;
+ else {
+ module_name = tv; name();
+ if (!module_known(module_name)) { word link = chk_resize(0, 0, 2); link[0] = included_modules; link[1] = module_name; included_modules = link; }
+ }
+ module_imports = 0; expect(s_semi); return 0;
+}
+// typecheck on; / typecheck off;
+int kw_typecheck() {
+ next();
+ if (is_id(s_on)) {
+ tc_on = 1;
+ } else if (is_id(s_off)) tc_on = 0; else die("typecheck on or typecheck off");
+ next(); expect(s_semi);
+ return 0;
+}
+// docs on; keeps the doc comments of what follows in the image, docs off; stops
+int kw_docs() {
+ next();
+ if (is_id(s_on)) {
+ docs_on = 1;
+ } else if (is_id(s_off)) docs_on = 0; else die("docs on or docs off");
+ next(); expect(s_semi);
+ return 0;
+}
+// hints on; / hints small; / hints off; from here to the end of the document (or the next such line)
+int kw_hints() {
+ int level = 2, at = toff;
+ next();
+ if (is_id(s_on)) level = 2; else if (is_id(s_small)) level = 1; else if (is_id(s_off)) level = 0;
+ else { die("hints on, hints small or hints off"); return 0; }
+ hint_set(level, at);
+ next(); expect(s_semi);
+ return 0;
+}
+// the doc symbol of a name: the symbol "doc name" that holds its byte string,
+// or -1. the chain is walked by hand because lookup hides what is below vislo
+int docsym(char* nm) {
+ int i, k = 0; char* p = "doc ";
+ doc_name_room(rt.len_w(nm) + 5);
+ while (p[k]) { dnmb[k] = p[k]; k++; }
+ i = 0; while (nm[i]) { dnmb[k] = nm[i]; k++; i++; }
+ dnmb[k] = 0;
+ nm = intern(dnmb);
+ i = nm[-1] - 1;
+ while (i >= 0) {
+ if (skind[i] == K_DOC) return i;
+ i = snext[i] - 1;
+ }
+ return -1;
+}
+// the packed documentation of a name (a byte string) or 0
+bstr docofs(char* nm) {
+ int s = docsym(nm);
+ if (s < 0) return 0;
+ return sval[s];
+}
+// the documentation of a function, by address
+bstr docof(int f) {
+ int i = nsym;
+ while (i) {
+ i--;
+ if (skind[i] == K_FN && sval[i] == f && (sflag[i] & F_DEF)) return docofs(sname[i]);
+ }
+ return 0;
+}
+// documentation uses stable packed objects. symbols keep them alive until an
+// image copies their bytes after its code; ordinary docofs calls work too.
+bstr doc_pack(char* text, int length) {
+ int i = 0, k, c, w, nw = (length + 7) >> 3; word p = chk_resize(0, 0, nw + 2);
+ p[-4] = p[-4] | rt.F_SHARE | rt.F_INTERNAL; p[0] = length;
+ while (i < length) {
+ w = 0; k = 0;
+ while (k < 8 && i < length) { c = text[i]; if (c > 255) c = 63; w = w | (c << (k * 8)); k++; i++; }
+ p[1 + ((i - 1) >> 3)] = w;
+ }
+ return p;
+}
+// section headings are organizational text, never documentation for a symbol.
+int doc_section(char* text, int length) {
+ int start = 0, end, a, b;
+ while (start < length) {
+ end = start; while (end < length && text[end] != 10) end++;
+ a = start; b = end;
+ while (a < b && (text[a] == 32 || text[a] == 9 || text[a] == 13)) a++;
+ while (b > a && (text[b - 1] == 32 || text[b - 1] == 9 || text[b - 1] == 13)) b--;
+ if (b - a >= 4 && text[a] == '-' && text[a + 1] == '-' && text[b - 1] == '-' && text[b - 2] == '-') return 1;
+ start = end + 1;
+ }
+ return 0;
+}
+
+// attach the doc comment above a declaration at name n.
+int doc_attach(char* n) {
+ int i = 0, w, k, c, b, nw;
+ if (!dsn || !n || dry || ginst || doc_section(dsnap, dsn)) return 0;
+ b = doc_pack(dsnap, dsn);
+ doc_name_room(rt.len_w(n) + 5);
+ i = 0; while ("doc "[i]) { dnmb[i] = "doc "[i]; i++; }
+ k = 0; while (n[k]) { dnmb[i] = n[k]; i++; k++; }
+ dnmb[i] = 0;
+ addsym(intern(dnmb), K_DOC, b);
+ dsn = 0;
+ return 0;
+}
+// the signature of a function as source text, "int put_c(int ch)", kept in the
+// image as the symbol "sig name" when docs are on, so the language server can
+// show it for any genome function, with or without a doc comment. the text is
+// printed through put_c with the output sent to sgb (the same redirect the
+// check uses for a parse word that prints)
+char[400] sgb_initial; char* sgb = sgb_initial; int sigcap = 400;
+int sig_print(char* n, int rty, int np, char** pn, word pty, int typed) {
+ int i = 0;
+ if (typed) { tprint(rty); rt.put_c(' '); } else rt.put_s("fn ");
+ rt.put_s(n); rt.put_c('(');
+ while (i < np) {
+ if (i) rt.put_s(", ");
+ if (typed) { tprint(pty[i]); rt.put_c(' '); }
+ rt.put_s(pn[i]); i++;
+ }
+ rt.put_c(')'); return 0;
+}
+// attach a complete signature, measured before capture.
+int sig_attach(char* n, int rty, int np, char** pn, word pty, int typed) {
+ int i = 0, k, b, nw, sm, sb, sn, sc, sl, w, c;
+ if (!docs_on || dry || ginst || ntp || panic) return 0;
+ sm = rt.outmode; sb = rt.outbuf; sn = rt.outn; sc = rt.outcap;
+ rt.outmode = 3; rt.outn = 0; sig_print(n, rty, np, pn, pty, typed);
+ if (rt.outn > sigcap) { while (rt.outn > sigcap) sigcap = sigcap * 2; sgb = chk_resize(sgb, 0, sigcap); }
+ rt.outmode = 2; rt.outbuf = sgb; rt.outn = 0; rt.outcap = sigcap;
+ sig_print(n, rty, np, pn, pty, typed);
+ sl = rt.outn;
+ rt.outmode = sm; rt.outbuf = sb; rt.outn = sn; rt.outcap = sc;
+ b = doc_pack(sgb, sl);
+ doc_name_room(rt.len_w(n) + 5);
+ i = 0; while ("sig "[i]) { dnmb[i] = "sig "[i]; i++; }
+ k = 0; while (n[k]) { dnmb[i] = n[k]; i++; k++; }
+ dnmb[i] = 0;
+ addsym(intern(dnmb), K_DOC, b);
+ return 0;
+}
+// the field of a struct type, or -1
+// ---- built-ins that look like functions ----
+
+// sizeof and typeof take a type or an expression; the expression form is
+// compiled with dry set so it contributes only its type. len, cap, push, pop
+// and resize work on growable arrays (T[?] handles in rt.zc); arrarg parses
+// their first argument and remembers which local it was, so the o3 and
+// bounds-proof machinery can see it.
+int tfindfield(word t, char* n) {
+ int i = 0;
+ tresolve(t);
+ while (i < t[3]) {
+ if (t[4][i * 3] == n) return i;
+ i++;
+ }
+ return -1;
+}
+// sizeof(T or expr), typeof(T or expr): the expression form is compiled dry, so it never runs
+int typearg() {
+ int t, sb, c, ob;
+ expect(s_lp);
+ if (tstart() && !is_op(s_dot)) t = ptype();
+ else {
+ sb = snap_push(); ob = xbor; dry++;
+ c = expr(); rval();
+ t = xty;
+ dry--; xbor = ob; snap_restore(sb); snap_pop(sb);
+ }
+ expect(s_rp);
+ return t;
+}
+// len(a), cap(a), push(a, x), pop(a), resize(a, n): growable arrays.
+// len of a T[n] is just n.
+word arrvalue(int c) {
+ argloc = -1; arrloc = -1;
+ if (lv && lvk == LV_LOCAL && xty[0] == TY_DYN) {
+ arrloc = lvi;
+ if (o3on && o3cache[lvi]) argloc = lvi;
+ }
+ effect_value = effect_mask(c); rval(); plainuse(c); af_access(xaf, tpack());
+ return xty;
+}
+// parse an array argument and retain the receiver's mutation and bounds facts.
+word arrarg() {
+ int c;
+ expect(s_lp); c = expr();
+ return arrvalue(c);
+}
+// report an error when a fixed array is asked to grow or shrink.
+int nogrow(word t) {
+ require_mutable(t);
+ if (t[0] == TY_ARR || (t[0] == TY_DYN && t[3])) serr("a fixed array can't grow or shrink");
+ return 0;
+}
+// compile len(a): the length of an array.
+int array_len(word t) {
+ int a = arrloc;
+ xcls = C_PLAIN; xaf = 0; xbor = -1; effect_value = 0;
+ expect(s_rp);
+ if (xstr) {
+ callname(s_len_s);
+ xty = tint;
+ xstr = 0;
+ xfloat = 0;
+ xlenloc = -1;
+ xstamp = 0;
+ return 0;
+ }
+ if (t[0] == TY_ARR) { op(O_DROP); lit(t[3]); }
+ else { tcneed(t[0] == TY_DYN || t == tword, "len needs an array", t); if (argloc >= 0) { op(O_DROP); vaddr(o3cache[argloc] + 1); op(O_LD); } else if (o3on && t[0] == TY_DYN) op(O_LD); else callname(s_dlen); }
+ xty = tint;
+ xlenloc = -1; xstamp = 0;
+ if (a >= 0 && t[0] == TY_DYN && t[3]) xlenloc = a; // the whole expression is len of a fixed array
+ return 0;
+}
+int kw_len() { next(); return array_len(arrarg()); }
+// compile cap(a): the capacity of a growable array.
+int array_cap(word t) {
+ xcls = C_PLAIN; xaf = 0; xbor = -1; effect_value = 0;
+ expect(s_rp);
+ if (t[0] == TY_ARR) { op(O_DROP); lit(t[3]); }
+ else { tcneed(t[0] == TY_DYN || t == tword, "cap needs an array", t); callname(s_dcap); }
+ xty = tint;
+ return 0;
+}
+int kw_cap() { next(); return array_cap(arrarg()); }
+// compile push(a, v): add an element to the end of a growable array.
+int array_push(word t) {
+ int c;
+ tcneed(t[0] == TY_DYN || t == tword, "push needs a T[?]", t);
+ effect_note_mask(effect_value, EF_WRITE); af_mutate(xaf, tpack()); nogrow(t);
+ if (t[0] == TY_DYN && isagg(t[4])) serr("push takes scalar or reference elements; use resize for aggregates");
+ c = expr(); rval(); if (t[0] == TY_DYN) fcoerce(t[4]);
+ if (isptr(xty) || xty == tword) effect_note_mask(effect_mask(c), EF_RETAIN); argcheck(c, 2);
+ if (t[0] == TY_DYN && !compat(t[4], xty)) tcerr("push", t[4], xty);
+ if (o3on && t[0] == TY_DYN && hasptr(t[4])) { lit(t[4]); callname(s_fatten); }
+ expect(s_rp);
+ if (t[0] == TY_DYN && tbytes(t[4])) { // packed: an f32 goes in as its 32 bits, the rest are cut by the store
+ if (isfl(t[4])) { if (!xfloat) op(OP_I2F); xenh("zf2s"); }
+ callname(intern("dpushb")); xty = tint; xfloat = 0; xcls = C_PLAIN;
+ return 0;
+ }
+ if (o3on && t[0] == TY_DYN && !hasptr(t[4]) && tsz(t[4]) == 1) { pushfast(); xty = tint; xfloat = 0; xcls = C_PLAIN; return 0; }
+ callname(s_dpush); xty = tint; xfloat = 0; xcls = C_PLAIN;
+ return 0;
+}
+int kw_push() { word t; next(); t = arrarg(); expect(s_comma); return array_push(t); }
+// pop in o3 code, inline: a non-empty array gives up its last word, an empty one is dpop's report
+int popfast() {
+ int k, e;
+ lit(0); op(O_PICK); op(O_LD);
+ k = hole(); op(O_JZ);
+ lit(0); op(O_PICK); op(O_LD); lit(1); op(O_SUB); lit(1); op(O_PICK); op(O_ST);
+ lit(0); op(O_PICK); op(O_LD);
+ lit(1); op(O_PICK); lit(2); op(O_ADD); op(O_LD);
+ op(O_ADD); lit(0); op(O_PICK); op(O_LD); op(O_SWAP); lit(0); op(O_SWAP); op(O_ST);
+ op(O_SWAP); op(O_DROP);
+ e = hole(); op(O_JMP);
+ setlit(k, here);
+ callname(s_dpop);
+ setlit(e, here);
+ return 0;
+}
+// push of a plain one-word element in o3 code, inline: when len < cap the word goes
+// straight into the items and len moves up, otherwise dpush grows the array
+int pushfast() {
+ int k, e;
+ lit(1); op(O_PICK); op(O_LD);
+ lit(2); op(O_PICK); lit(1); op(O_ADD); op(O_LD);
+ op(O_LT);
+ k = hole(); op(O_JZ);
+ lit(1); op(O_PICK); lit(2); op(O_ADD); op(O_LD);
+ lit(2); op(O_PICK); op(O_LD); op(O_ADD);
+ op(O_ST);
+ lit(0); op(O_PICK); op(O_LD); lit(1); op(O_ADD); lit(1); op(O_PICK); op(O_ST);
+ op(O_DROP); lit(0);
+ e = hole(); op(O_JMP);
+ setlit(k, here);
+ callname(s_dpush);
+ setlit(e, here);
+ return 0;
+}
+// compile pop(a): remove and return the last element of a growable array.
+int array_pop(word t) {
+ xcls = C_PLAIN;
+ tcneed(t[0] == TY_DYN || t == tword, "pop needs a T[?]", t);
+ effect_note_mask(effect_value, EF_WRITE); af_mutate(xaf, tpack());
+ nogrow(t);
+ if (t[0] == TY_DYN && isagg(t[4])) serr("pop takes scalar or reference elements; access the last aggregate before resizing");
+ expect(s_rp);
+ if (t[0] == TY_DYN && tbytes(t[4])) { // packed: read zero extended, then sign extend or widen
+ callname(intern("dpopb"));
+ xty = t[4]; xfloat = 0;
+ xaf = 0; xbor = -1; effect_value = 0;
+ pkfix(xty);
+ if (isfl(xty)) xfloat = 1;
+ return 0;
+ }
+ if (o3on && t[0] == TY_DYN && !hasptr(t[4]) && tsz(t[4]) == 1) popfast(); else callname(s_dpop);
+ xty = telem(t);
+ if (t[0] == TY_DYN) xty = t[4];
+ xfloat = 0;
+ if (isfl(xty)) xfloat = 1;
+ xaf = 0; xbor = -1; effect_value = 0;
+ if (isref(xty)) {
+ xcls = C_FRESH; xaf = af_new(-1, 2, tpack()); newsz = -1; newleaf = 0; return C_FRESH;
+ }
+ return 0;
+}
+int kw_pop() { next(); return array_pop(arrarg()); }
+// compile resize(a, n): set the length of a growable array.
+int array_resize(word t) {
+ int c;
+ tcneed(t[0] == TY_DYN || t == tword, "resize needs a T[?]", t);
+ effect_note_mask(effect_value, EF_WRITE); af_mutate(xaf, tpack());
+ nogrow(t);
+ c = expr();
+ rval();
+ tcneed(isnum(xty) || isfl(xty) || xty == tword, "resize needs a numeric length", xty);
+ fcoerce(tint);
+ plainuse(c);
+ expect(s_rp);
+ if (t[0] == TY_DYN && tbytes(t[4])) callname(intern("dresizeb")); else callname(s_dresize);
+ xty = tint; xcls = C_PLAIN; xfloat = 0;
+ return 0;
+}
+int kw_resize() { word t; next(); t = arrarg(); expect(s_comma); return array_resize(t); }
+// array receiver calls share the free-call lowering and ownership checks.
+int array_method(int n) {
+ return n == intern("len") || n == intern("cap") || n == intern("push") || n == intern("pop") || n == intern("resize");
+}
+int array_member(int c, int n) {
+ word t = arrvalue(c);
+ expect(s_lp);
+ if (n == intern("len")) return array_len(t);
+ if (n == intern("cap")) return array_cap(t);
+ if (n == intern("push")) return array_push(t);
+ if (n == intern("pop")) return array_pop(t);
+ return array_resize(t);
+}
+// compile sizeof(T) or sizeof(e): the size of a type or expression in words.
+int kw_sizeof() {
+ int t;
+ next();
+ t = typearg();
+ lit(tsz(t));
+ xty = tint;
+ return 0;
+}
+// compile typeof(e): the type of an expression, as a value.
+int kw_typeof() {
+ int t;
+ next();
+ t = typearg();
+ lit(t);
+ xty = tword;
+ return 0;
+}
+// ---- c abi: extern and cfunc ----
+
+// extern double pow(double, double); or with parameter names, and an
+// optional "= "cname"" to give the zc function another name than the c symbol.
+// the declaration is read with c's spelling of types and turned into an
+// ordinary zc function, so a call to it is a call like any other. the function
+// fills a block of words that sits in the code stream (the symbol's name, the
+// signature, a cache slot, then room for the arguments) and stores its arguments there,
+// and gate op 14 makes the native call (see the c abi section of core.c).
+// a signature is 4 bits per kind: the result, then each argument:
+// 0 void 1 long 2 double 3 byte pointer 4 int 5 float 6 word pointer
+// 7 unsigned int 8 short 9 unsigned short 10 char 11 unsigned char
+// 12 str, a zc byte string (b"..."), given to c as the address of its bytes
+// a double or float is a zc float. any pointer is a byte address (what
+// addr_b(s + 1) gives for a byte string), except "word *", which is a word
+// address (a zc object or array). native results come back the same way.
+// append the string s to the text being generated for an extern stub.
+int eb_char(int c) {
+ if (ebn + 2 > ebcap) { ebcap = ebcap * 2; ebuf = chk_resize(ebuf, ebn, ebcap); }
+ ebuf[ebn] = c; ebn++; ebuf[ebn] = 0; return 0;
+}
+int ebs(char* s) {
+ while (*s) { eb_char(*s); s++; }
+ ebuf[ebn] = 0;
+ return 0;
+}
+// append the decimal digits of n to the generated text.
+int ebn10(int n) {
+ if (n >= 10) ebn10(n / 10);
+ eb_char(48 + n % 10);
+ ebuf[ebn] = 0;
+ return 0;
+}
+// true for a c type keyword, like long, char or double.
+int ctypeword(int w) {
+ return rt.eq_w(w, "unsigned") || rt.eq_w(w, "signed") || rt.eq_w(w, "long") || rt.eq_w(w, "short") || rt.eq_w(w, "int") || rt.eq_w(w, "char") || rt.eq_w(w, "double") || rt.eq_w(w, "float") || rt.eq_w(w, "void") || rt.eq_w(w, "const") || rt.eq_w(w, "volatile");
+}
+// a c type at the current token: its signature kind, or -1 after an error.
+// skipname also eats a parameter name that follows.
+// a plain zc struct a native call takes by value: every field is one word (a long,
+// a double or a pointer), so word g of the struct is eightbyte g. returns its
+// word count, or -1 after an error.
+int cstruct_ok(word st, char* nm) {
+ int i = 0, n; word ft;
+ tresolve(st);
+ n = st[1];
+ if (st[0] != TY_STRUCT || st[5] || n < 1 || n > 15 || st[3] != n) { serrn(nm, "can't be passed by value to a native call: it needs one word fields, at most 15 words"); return 0 - 1; }
+ while (i < n) {
+ ft = st[4][i * 3 + 1];
+ if (tbytes(ft) || tsz(ft) != 1 || ft[0] == TY_STRUCT || ft[0] == TY_ARR || st[4][i * 3 + 2] != i) { serrn(nm, "can't be passed by value to a native call: every field has to be one word (long, double or a pointer)"); return 0 - 1; }
+ i++;
+ }
+ return n;
+}
+// the native signature kind of the c type at the current token, or -1 after an error.
+int ckind(int skipname) {
+ char* w; int uns = 0, lng = 0, shrt = 0, chr = 0, ints = 0, dbl = 0, flt = 0, vd = 0, ptr = 0, seen = 0, k = -1, sk, nw; word other = 0; char* sw = 0;
+ ckst = 0; ckn = 0;
+ while (tk == T_ID) {
+ w = tv;
+ if (rt.eq_w(w, "const") || rt.eq_w(w, "volatile") || rt.eq_w(w, "restrict")) { next(); continue; }
+ if (rt.eq_w(w, "struct") || rt.eq_w(w, "enum") || rt.eq_w(w, "union")) {
+ next();
+ if (tk == T_ID) { if (rt.eq_w(w, "struct")) sw = tv; next(); }
+ other = 1; seen = 1;
+ continue;
+ }
+ if (seen && !ctypeword(w)) break;
+ if (rt.eq_w(w, "unsigned")) uns = 1;
+ else if (rt.eq_w(w, "signed")) ints = 1;
+ else if (rt.eq_w(w, "long")) lng++;
+ else if (rt.eq_w(w, "short")) shrt = 1;
+ else if (rt.eq_w(w, "char")) chr = 1;
+ else if (rt.eq_w(w, "int")) ints = 1;
+ else if (rt.eq_w(w, "double") || rt.eq_w(w, "f64")) dbl = 1;
+ else if (rt.eq_w(w, "float") || rt.eq_w(w, "f32")) flt = 1;
+ else if (rt.eq_w(w, "void")) vd = 1;
+ else other = w;
+ seen = 1;
+ next();
+ }
+ if (!seen) { die("expected a c type"); return 0 - 1; }
+ while (is_op(s_star)) {
+ ptr = 1; next();
+ while (is_id(intern("const"))) next();
+ }
+ if (skipname && tk == T_ID) next();
+ if (ptr) {
+ if (other && other != 1 && rt.eq_w(other, "word")) return 6;
+ return 3;
+ }
+ if (dbl) return 2;
+ if (flt) return 5;
+ if (vd) return 0;
+ if (chr) { if (uns) return 11; return 10; }
+ if (shrt) { if (uns) return 9; return 8; }
+ if (lng) return 1;
+ if (ints || uns) { if (uns) return 7; return 4; }
+ if (other == 1) {
+ if (!sw) { serr("a struct has to be passed by pointer"); return 0 - 1; }
+ sk = lookup(sw);
+ if (sk < 0 || skind[sk] != K_TYPE || sval[sk][0] != TY_STRUCT) { serrn(sw, "isn't a zc struct: a native call takes a zc struct by value, declared with word fields"); return 0 - 1; }
+ nw = cstruct_ok(sval[sk], sw);
+ if (nw < 0) return 0 - 1;
+ ckst = sval[sk]; ckn = sw;
+ if (nw <= 2) return 13; // in registers when they fit (sysv: 16 bytes or less)
+ return 14; // in memory: on the stack, word after word
+ }
+ if (rt.eq_w(other, "str")) return 12;
+ if (rt.eq_w(other, "size_t") || rt.eq_w(other, "ssize_t") || rt.eq_w(other, "intptr_t") || rt.eq_w(other, "uintptr_t") || rt.eq_w(other, "ptrdiff_t") || rt.eq_w(other, "int64_t") || rt.eq_w(other, "uint64_t") || rt.eq_w(other, "off_t") || rt.eq_w(other, "time_t") || rt.eq_w(other, "word")) return 1;
+ if (rt.eq_w(other, "int32_t") || rt.eq_w(other, "i32")) return 4;
+ if (rt.eq_w(other, "uint32_t") || rt.eq_w(other, "u32")) return 7;
+ if (rt.eq_w(other, "int16_t") || rt.eq_w(other, "i16")) return 8;
+ if (rt.eq_w(other, "uint16_t") || rt.eq_w(other, "u16")) return 9;
+ if (rt.eq_w(other, "int8_t") || rt.eq_w(other, "i8")) return 10;
+ if (rt.eq_w(other, "uint8_t") || rt.eq_w(other, "u8") || rt.eq_w(other, "byte") || rt.eq_w(other, "bool") || rt.eq_w(other, "_Bool")) return 11;
+ serrn(other, "isn't a c type extern knows (use long, int, double, a pointer, ...)");
+ return 0 - 1;
+}
+// true for a native kind that travels in a float register.
+int ckindfloat(int k) { return k == 2 || k == 5; }
+// parse an extern declaration: a c function with its signature, and a zc stub for it.
+int kw_extern() {
+ int rk; word[16] ks; word[16] kst; char*[16] ksn; int np = 0, k; char* fname; char* cname; int i, a, j, n, w, sig, bad = 0; char* buf; word oldimports = module_imports; int pos, len, g; word st, rst; int rn, rsd, sret = 0;
+ stmtonly();
+ next();
+ rk = ckind(0);
+ // a struct result: the stub makes it (new) and passes it as the first item; the
+ // call block's word 2 says how many words it has and which of them are floats
+ if (rk >= 13) {
+ sret = 1; rst = ckst; rn = ckn;
+ if (rst[1] > 7) { serr("a native call can return at most 7 words"); rk = 0 - 1; }
+ }
+ fname = name();
+ cname = fname;
+ expect(s_lp);
+ if (!is_op(s_rp)) {
+ while (1) {
+ k = ckind(1);
+ if (k < 0) { bad = 1; break; }
+ if (k == 0 && np == 0 && is_op(s_rp)) break; // (void)
+ if (k == 0) { serr("a parameter can't be void"); bad = 1; break; }
+ if (np >= 15) { serr("a native call takes at most 15 arguments"); bad = 1; break; }
+ ks[np] = k; kst[np] = ckst; ksn[np] = ckn; np++;
+ if (!accept(s_comma)) break;
+ }
+ }
+ expect(s_rp);
+ if (accept(s_eq)) {
+ if (tk != T_STR) { die("expected the c name as a string"); return 0; }
+ cname = tv;
+ next();
+ }
+ expect(s_semi);
+ if (bad || rk < 0 || panic) return 0;
+ if (sret && np > 14) { serr("a native call that returns a struct takes at most 14 arguments"); return 0; }
+ rsd = 0;
+ if (sret) {
+ rsd = rst[1]; g = 0;
+ while (g < rst[1]) {
+ if (rst[4][g * 3 + 1] == tfloat) rsd = rsd | (2 << (4 + 4 * g)); else rsd = rsd | (1 << (4 + 4 * g));
+ g++;
+ }
+ }
+ // the block, then the name as packed bytes, then the block's own address
+ // (the word before the stub's entry, which is how a call site finds it):
+ // [0] the name's byte address, [1] the signature, [2] a lookup cache the
+ // host fills in, [3..17] the arguments, [18..] the name
+ // the arguments' nibbles: one per argument. a struct is a group: code 13 (in
+ // registers if they fit) or 14 (in memory), its length in eightbytes, then one
+ // class nibble per eightbyte (2 for a float word, 1 otherwise). the group is one
+ // stack item: the struct's address
+ sig = rk;
+ pos = 1; i = 0;
+ while (i < np) {
+ if (ks[i] < 13) {
+ sig = sig | (ks[i] << (4 * pos)); pos++;
+ } else {
+ st = kst[i]; len = st[1];
+ if (pos + 1 + len > 15) { serr("the arguments of this native call are too many words"); return 0; }
+ sig = sig | (ks[i] << (4 * pos)); pos++;
+ sig = sig | (len << (4 * pos)); pos++;
+ g = 0;
+ while (g < len) {
+ if (st[4][g * 3 + 1] == tfloat) sig = sig | (2 << (4 * pos)); else sig = sig | (1 << (4 * pos));
+ pos++; g++;
+ }
+ }
+ i++;
+ }
+ j = hole();
+ op(O_JMP);
+ reserve_code(20 + (rt.len_w(cname) >> 3)); a = here;
+ emit((a + 18) << 3);
+ emit(sig);
+ emit(rsd << 32); // the cache's half is the host's; this half is the result's descriptor
+ i = 3;
+ while (i < 18) { emit(0); i++; }
+ n = 0;
+ while (cname[n]) n++;
+ i = 0;
+ while (i < n) {
+ w = 0; k = 0;
+ while (k < 8 && i < n) { w = w | (cname[i] << (k * 8)); k++; i++; }
+ emit(w);
+ }
+ if (!(n & 7)) emit(0);
+ emit(a);
+ setlit(j, here);
+ // the stub, compiled as if it had been written in the source. it stays
+ // for the places that take the function's address; a direct call to it
+ // compiles to the native-call opcode instead (see call)
+ ebn = 0; ebuf[0] = 0;
+ if (sret) { ebs(rn); ebs("*.u "); }
+ else if (rk == 5) ebs("f32 "); else if (ckindfloat(rk)) ebs("float "); else ebs("int ");
+ ebs(fname); ebs("(");
+ i = 0;
+ while (i < np) {
+ if (i) ebs(", ");
+ if (ks[i] >= 13) { ebs(ksn[i]); ebs(" p"); } else if (ks[i] == 5) ebs("f32 p"); else if (ckindfloat(ks[i])) ebs("float p"); else ebs("int p");
+ ebn10(i);
+ i++;
+ }
+ ebs(") { let b = "); ebn10(a); ebs(";");
+ // the native descriptor borrows an integer address, not ownership of r.
+ // clear that scratch address after the call so it cannot keep the result rooted.
+ if (sret) { ebs(" "); ebs(rn); ebs("* r = rt.new("); ebs(rn); ebs("); b[3] = core.addr_b(r) >> 3;"); }
+ i = 0;
+ while (i < np) { ebs(" b["); ebn10(i + 3 + sret); ebs("] = p"); ebn10(i); ebs(";"); i++; }
+ if (sret) ebs(" core.syscall(14, b, 0, 0); b[3] = 0; return r; }");
+ else {
+ ebs(" return core.syscall(14, b, 0, 0)");
+ if (rk == 5) ebs(" as f32"); else if (ckindfloat(rk)) ebs(" as float");
+ ebs("; }");
+ }
+ buf = rt.new(ebn + 19);
+ rt.copy_w(buf, "include rt, core; ", 18);
+ rt.copy_w(buf + 18, ebuf, ebn + 1);
+ src_push(2, buf, 0, 0);
+ next();
+ stubgen = 1; // the stub is ours, not the document's: its locals get no hints
+ while (tk != T_EOF) topitem();
+ stubgen = 0;
+ src_pop();
+ module_imports = oldimports;
+ rt.free(buf);
+ k = lookup(fname);
+ if (k >= 0 && skind[k] == K_FN && (sflag[k] & F_DEF) && !sret) sflag[k] = sflag[k] | F_EXT; // a struct result is called as its stub
+ return 0;
+}
+// the c kind of a zc type, for cfunc
+int ckindof(word t) {
+ if (t == tfloat) return 2;
+ if (t == tf32) return 5;
+ if (t[0] == TY_INT && t[5]) { // i8 u8 i16 u16 i32 u32 pass and come back at their width
+ if (t[5] == 1) { if (t[6] & 1) return 10; return 11; }
+ if (t[5] == 2) { if (t[6] & 1) return 8; return 9; }
+ if (t[6] & 1) return 4;
+ return 7;
+ }
+ if (t == tvoid) return 0;
+ if (t[0] == TY_PTR || t[0] == TY_ARR || t[0] == TY_DYN) return 6;
+ return 1;
+}
+// cfunc(f): a native function pointer that runs the zc function f, with the
+// c signature its declared types give (float is a double, f32 a c float, i8..u32 their width, a pointer is a word
+// address, anything else a long). the pointer can be given to c code, which
+// may call it while a native call from zc is running.
+int kw_cfunc() {
+ int s; word t; int sig = 1, i, nm;
+ next();
+ expect(s_lp);
+ if (tk != T_ID) { die("cfunc needs the name of a function"); return 0; }
+ s = source_lookup(tv);
+ if (s < 0 || skind[s] != K_FN) { serrn(tv, "isn't a function"); return 0; }
+ t = sigof(sval[s]);
+ if (!t) t = stype[s];
+ if (t && t[0] == TY_FN) {
+ sig = ckindof(t[4]);
+ i = 0;
+ if (t[3] > 14) serrn(tv, "has more than 14 parameters");
+ while (i < t[3] && i < 14) { sig = sig | (ckindof(t[7 + i]) << (4 * (i + 1))); i++; }
+ } else {
+ i = (ssig[s] >> 1) & 31;
+ while (i > 0) { i--; sig = sig | (1 << (4 * (i + 1))); }
+ }
+ expr(); rval();
+ lit(sig);
+ callname(intern("cbmake"));
+ expect(s_rp);
+ xty = tint; xfloat = 0;
+ return 0;
+}
+// intern the built-in types and the spellings the parser compares against.
+// the s_ names are plain globals holding interned handles, so a check like
+// is_id(s_fn) is one pointer compare.
+int types_init() {
+ word f32p;
+ readonly_types = 0;
+ tytop = R_TY + NTL; tyend = R_TYEND; typeblocks = 0; ntl = 0; fieldn = 0;
+ if (R_TY + typecap > R_TYEND && typelist == R_TY) typelist = chk_resize(0, 0, typecap);
+ tword = tnew(TY_WORD, 1, intern("word"), 0);
+ tint = tnew(TY_INT, 1, intern("int"), 0);
+ tchar = tnew(TY_CHAR, 1, intern("char"), 0);
+ tbool = tnew(TY_BOOL, 1, intern("bool"), 0);
+ tvoid = tnew(TY_VOID, 0, intern("void"), 0);
+ tfloat = tnew(TY_FLOAT, 1, intern("float"), 0);
+ tbstr = tnew(TY_BSTR, 1, intern("bstr"), 0); addsym(tbstr[2], K_TYPE, tbstr);
+ addsym(tword[2], K_TYPE, tword); addsym(tint[2], K_TYPE, tint); addsym(tchar[2], K_TYPE, tchar);
+ addsym(tbool[2], K_TYPE, tbool); addsym(tvoid[2], K_TYPE, tvoid); addsym(tfloat[2], K_TYPE, tfloat);
+ addsym(intern("f64"), K_TYPE, tfloat);
+ addsym(intern("string"), K_TYPE, tptr(tchar)); // string is char*, as if by typedef char* string;
+ // f32: single precision. a variable holds the rounded value as a double; an element
+ // of an array or pointer of f32 is packed two to a word, like the sized integers
+ f32p = tnew(TY_FLOAT, 1, intern("f32"), 0);
+ tf32 = tnew(TY_FLOAT, 1, f32p[2], 0);
+ tf32[5] = 4; tf32[4] = f32p; f32p[5] = 4; f32p[6] = 2;
+ addsym(tf32[2], K_TYPE, tf32);
+ tsized("i8", 1, 1); addsym(intern("byte"), K_TYPE, tsized("u8", 1, 0));
+ tsized("i16", 2, 1); tsized("u16", 2, 0); tsized("i32", 4, 1); tsized("u32", 4, 0);
+ s_lt = intern("<");
+ s_gt = intern(">");
+ s_shr = intern(">>");
+ s_le = intern("<=");
+ s_ge = intern(">=");
+ s_eqeq = intern("=="); s_ne = intern("!="); s_plus = intern("+");
+ s_struct = intern("struct"); s_type = intern("type"); s_typedef = intern("typedef"); s_typecheck = intern("typecheck"); s_docs = intern("docs"); s_std = intern("std"); s_icon = intern("icon"); s_small = intern("small");
+ s_on = intern("on");
+ s_off = intern("off");
+ s_new = intern("rt.new");
+ s_new_t = intern("rt.new_t");
+ s_new_k = intern("rt.new_k");
+ s_recycle_leaf = intern("rt.recycle_leaf");
+ s_hitems = intern("#items"); s_hlen = intern("#len"); s_fatten = intern("run.fatten");
+ s_this = intern("this");
+ s_o3 = intern("o3");
+ s_lfa = intern("rt.lfa");
+ s_outside = intern("rt.outside");
+ s_new_raw = intern("rt.new_raw");
+ s_oob = intern("rt.oob");
+ s_new_oz = intern("rt.new_oz");
+ s_ld8 = intern("rt.ld8"); s_st8 = intern("rt.st8"); s_ld16 = intern("rt.ld16"); s_st16 = intern("rt.st16");
+ s_ld32 = intern("rt.ld32"); s_st32 = intern("rt.st32");
+ s_fixed = intern("fixed");
+ s_dlen = intern("rt.dlen");
+ s_dcap = intern("rt.dcap");
+ s_dnew = intern("rt.dnew");
+ s_dat = intern("rt.dat");
+ s_len_s = intern("rt.len_s");
+ s_at_s = intern("rt.at_s");
+ s_slice_s = intern("rt.slice_s");
+ s_cat_s = intern("rt.cat_s");
+ s_eq_s = intern("rt.eq_s");
+ s_lt_s = intern("rt.lt_s");
+ s_le_s = intern("rt.le_s");
+ s_put_bs = intern("rt.put_bs");
+ s_put_s = intern("rt.put_s");
+ s_n_to_s = intern("rt.n_to_s"); s_new_s = intern("rt.new_s");
+ s_dpush = intern("rt.dpush"); s_dpop = intern("rt.dpop"); s_dresize = intern("rt.dresize");
+ numops[0] = intern("*"); numops[1] = intern("/"); numops[2] = intern("%"); numops[3] = intern("&");
+ numops[4] = intern("|");
+ numops[5] = intern("^");
+ numops[6] = intern("<<");
+ numops[7] = s_shr;
+ nnumops = 8;
+ return 0;
+}
+// true for an operator that works on numbers.
+int isnumop(int o) {
+ int i = 0;
+ while (i < nnumops) {
+ if (numops[i] == o) return 1;
+ i++;
+ }
+ return 0;
+}
+// the type of a binary operation, checking it when the typechecker is on
+// the result type of binary operator b, which is also where the typechecker
+// complains: pointer plus int is that pointer, pointer minus pointer is an int,
+// word on either side wins, and a float on either side makes arithmetic float.
+word bintype(int b, word lt, word rhs_type) {
+ int o = bname[b];
+ lt = decay(lt); rhs_type = decay(rhs_type);
+ if (blen[b] < 0) { tcneed(!isagg(lt) && !isagg(rhs_type), "&& and || need scalars", lt); return tbool; }
+ if (isfl(lt) || isfl(rhs_type)) {
+ if (o == s_plus || o == s_minus || o == s_star || o == s_slash) {
+ if (lt[0] == TY_PTR || rhs_type[0] == TY_PTR) { tcerr("+", lt, rhs_type); return tword; }
+ return tfloat;
+ }
+ if (o == s_eqeq || o == s_ne || o == s_lt || o == s_gt || o == s_le || o == s_ge) return tbool;
+ }
+ if (o == s_eqeq || o == s_ne) {
+ if (!compat(lt, rhs_type) && !compat(rhs_type, lt)) tcerr("comparison", lt, rhs_type);
+ return tbool;
+ }
+ if (o == s_lt || o == s_gt || o == s_le || o == s_ge) {
+ if (!(lt == tword || rhs_type == tword || (isnum(lt) && isnum(rhs_type)) || (lt[0] == TY_PTR && rhs_type[0] == TY_PTR))) {
+ tcerr("comparison", lt, rhs_type);
+ }
+ return tbool;
+ }
+ if (o == s_plus) {
+ if (lt[0] == TY_PTR && (isnum(rhs_type) || rhs_type == tword)) return lt;
+ if (rhs_type[0] == TY_PTR && isnum(lt)) return rhs_type;
+ if (lt == tword || rhs_type == tword) return tword;
+ if (isnum(lt) && isnum(rhs_type)) return tint;
+ tcerr("+", lt, rhs_type); return tword;
+ }
+ if (o == s_minus) {
+ if (lt[0] == TY_PTR && rhs_type[0] == TY_PTR) return tint;
+ if (lt[0] == TY_PTR && (isnum(rhs_type) || rhs_type == tword)) return lt;
+ if (lt == tword || rhs_type == tword) return tword;
+ if (isnum(lt) && isnum(rhs_type)) return tint;
+ tcerr("-", lt, rhs_type); return tword;
+ }
+ if (isnumop(o)) {
+ if (lt == tword || rhs_type == tword) return tword;
+ if (isnum(lt) && isnum(rhs_type)) return tint;
+ if (isnum(lt)) lt = rhs_type;
+ tcneed(0, "arithmetic needs numbers", lt); return tword;
+ }
+ return tword; // operators a program added
+}
+
+// ---- reflection ----
+
+// for programs (and parse words) looking at types at runtime
+word tkind(word t) { return t[0]; }
+// the size of a type in words.
+word tsize(int t) { return tsz(t); }
+// the name of a type.
+char* tname(word t) { return t[2]; }
+// the length of an array type.
+word tlen(word t) { return t[3]; }
+// the number of fields of a struct type.
+word tnfields(word t) { tresolve(t); return t[3]; }
+// ---- fattening ----
+
+// typed new stamps the header, in o3 the same as outside it. fatten is for a
+// value that still has new_raw's blank type word when it reaches code that
+// isn't o3: a store into a normal local or a global, an argument to a
+// function that isn't o3, the call site where non-o3 code calls an o3
+// function whose result has pointers, and the end of an o3 block. a child
+// store of a value new(T) just allocated, or that an o3 function returned,
+// does not call fatten: the header is already that type. a call or return
+// from o3 to o3 does not fatten. fatten(p, t) stamps the type, zeroes the
+// slack, and follows every typed pointer. it returns p.
+// a type whose objects can never hold a pointer: numbers, chars, bools, and
+// arrays and plain structs of them. word, generics and anything unknown say no
+// two questions about a type's shape, both answered structurally:
+// isleaf can an object of this type never hold a heap pointer? the
+// allocator uses it to pick the recycle_leaf fast path (no children
+// to walk, so the block goes straight back on its size-class list).
+// hasptr can it hold one? fatten uses it to decide whether stamping a
+// type has to follow pointers.
+word isleaf(word t) {
+ int k = t[0], i, n;
+ if (k == TY_INT || k == TY_CHAR || k == TY_BOOL || k == TY_FLOAT) return 1;
+ if (k == TY_ARR) return isleaf(t[4]);
+ if (k == TY_STRUCT && !t[5]) {
+ n = tnfields(t);
+ i = 0;
+ while (i < n) {
+ if (!isleaf(tftype(t, i))) return 0;
+ i++;
+ }
+ return 1;
+ }
+ return 0;
+}
+// true when a value of type t holds a pointer that fattening must follow.
+word hasptr(word t) {
+ int k = t[0], i, n;
+ if (k == TY_PTR || k == TY_DYN || k == TY_BSTR) return 1;
+ if (k == TY_ARR) return hasptr(t[4]);
+ if (k == TY_STRUCT && !t[5]) {
+ n = tnfields(t);
+ i = 0;
+ while (i < n) {
+ if (hasptr(tftype(t, i))) return 1;
+ i++;
+ }
+ }
+ return 0;
+}
+// stamp p with its type t, then the pointers it holds.
+int fatten(int p, int t) { fat1(p, t, 32); return p; }
+// stamp p with type t if it has no type yet, then follow its pointers. dl is a
+// depth limit so a cycle through growable arrays ends. a raw header holds
+// -(n + 1) for an object of n words, which tells how many elements to type.
+int fat1(word p, word t, int dl) {
+ word e; int n, k, i, es;
+ if (dl <= 0 || !t || !rt.isobj(p)) return 0;
+ if (t[0] == TY_DYN) { // a handle is always fat; what it holds may not be
+ if (hasptr(t[4])) {
+ es = tsz(t[4]);
+ n = p[0];
+ i = 0;
+ while (i < n) { fatin(p[2] + i * es, t[4], dl - 1); i++; }
+ }
+ return 0;
+ }
+ if (t[0] != TY_PTR || p[-1] >= 0) return 0;
+ e = t[4]; n = 0 - p[-1] - 1; es = tsz(e);
+ if (es < 1) es = 1;
+ if (e == tword || e[0] == TY_VAR) p[-1] = 0;
+ else if (n > es) p[-1] = tarr(e, 0);
+ else p[-1] = e;
+ if (rt.osize(p) > n) rt.fill_w(p + n, 0, rt.osize(p) - n);
+ if (hasptr(e)) { k = n / es; i = 0; while (i < k) { fatin(p + i * es, e, dl - 1); i++; } }
+ return 0;
+}
+// fatten the value stored at address a, which has type t: a pointer or handle
+// is fattened itself, an array or struct is walked element by element
+word fatin(word a, word t, int dl) {
+ int k = t[0], i, n, o, ft, es;
+ if (k == TY_PTR || k == TY_DYN) return fat1(a[0], t, dl);
+ if (k == TY_ARR) {
+ if (!hasptr(t[4])) return 0;
+ n = t[3];
+ es = tsz(t[4]);
+ i = 0;
+ while (i < n) { fatin(a + i * es, t[4], dl); i++; }
+ return 0;
+ }
+ if (k == TY_STRUCT && !t[5]) {
+ n = tnfields(t);
+ i = 0;
+ while (i < n) {
+ o = tfoff(t, i);
+ ft = tftype(t, i);
+ if (o >= 0) fatin(a + o, ft, dl);
+ i++;
+ }
+ }
+ return 0;
+}
+// reflection accessors over type records (see the layout under types). they
+// resolve a generic instance first, so asking about vec<int> works.
+char* tfname(word t, int i) { tresolve(t); return t[4][i * 3]; }
+// the type of field i of a struct.
+word tftype(word t, int i) { tresolve(t); return t[4][i * 3 + 1]; }
+// the offset of field i of a struct.
+word tfoff(word t, int i) { tresolve(t); return t[4][i * 3 + 2]; }
+// the return type of a function type.
+word tret(word t) { return t[4]; }
+// the number of parameters of a function type.
+word tnparams(word t) { return t[3]; }
+// the type of parameter i of a function type.
+word tparam(word t, int i) { return t[7 + i]; }
+// the tag of parameter i: 0 untagged, 1 .m, 2 .d.
+word tparamtag(word t, int i) { return ((t[5] >> 6) >> (i + i)) & 3; } // 0 untagged (m), 1 .m, 2 .d
+// true when a function type returns an owned object (.u).
+word tretu(word t) { return t[5] & 1; }
+// the number of type arguments a generic struct instance has.
+word tnargs(word t) {
+ if (t[0] != TY_STRUCT || !t[5]) return 0;
+ return t[6][0];
+}
+// type argument i of a generic struct instance.
+word targ(word t, int i) { return t[6][1 + i]; }
+// the type of a function, by address. untyped functions get one made from their signature
+// ---- function types by address ----
+
+word sigof(int f) {
+ int i = nsym, s = -1; word[24] ws; int n, k;
+ while (i) { i--; if (skind[i] == K_FN && sval[i] == f && (sflag[i] & F_DEF)) { s = i; break; } }
+ if (s < 0) return 0;
+ if (stype[s]) return stype[s];
+ n = (ssig[s] >> 1) & 31; k = 0;
+ while (k < n) { ws[k] = tword; k++; }
+ return tfn(tword, n, ws, ssig[s]);
+}
+// the function type of the function named nm, or 0 when there is none.
+word sigofs(char* nm) {
+ int s = lookups(nm);
+ if (s < 0 || skind[s] != K_FN) return 0;
+ return sigof(sval[s]);
+}
+
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-27 20:55:50 +0000