// 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; } // lines on; records line tables for the functions that follow, lines off; stops (see lt_begin) int kw_lines() { next(); if (is_id(s_on)) { lines_on = 1; } else if (is_id(s_off)) lines_on = 0; else die("lines on or lines 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_lines = intern("lines"); 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_bchk = intern("rt.bchk"); s_bnd = intern("rt.bnd"); 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 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]); }