summaryrefslogtreecommitdiff
path: root/vere/pkg/noun/nock.c
diff options
context:
space:
mode:
Diffstat (limited to 'vere/pkg/noun/nock.c')
-rw-r--r--vere/pkg/noun/nock.c3268
1 files changed, 3268 insertions, 0 deletions
diff --git a/vere/pkg/noun/nock.c b/vere/pkg/noun/nock.c
new file mode 100644
index 0000000..8218efa
--- /dev/null
+++ b/vere/pkg/noun/nock.c
@@ -0,0 +1,3268 @@
+/// @file
+
+#include "nock.h"
+
+#include "allocate.h"
+#include "hashtable.h"
+#include "imprison.h"
+#include "jets.h"
+#include "jets/k.h"
+#include "jets/q.h"
+#include "manage.h"
+#include "options.h"
+#include "retrieve.h"
+#include "trace.h"
+#include "vortex.h"
+#include "xtract.h"
+#include "zave.h"
+
+
+// define to have each opcode printed as it executes,
+// along with some other debugging info
+# undef VERBOSE_BYTECODE
+
+#if 0
+// Retained for debugging purposes.
+static u3_noun _n_nock_on(u3_noun bus, u3_noun fol);
+
+/* _n_hint(): process hint.
+*/
+static u3_noun
+_n_hint(u3_noun zep,
+ u3_noun hod,
+ u3_noun bus,
+ u3_noun nex)
+{
+ switch ( zep ) {
+ default: {
+ // u3m_p("weird zep", zep);
+ u3a_lose(zep);
+ u3a_lose(hod);
+
+ return _n_nock_on(bus, nex);
+ }
+
+ case c3__hunk:
+ case c3__lose:
+ case c3__mean:
+ case c3__spot: {
+ u3_noun tac = u3nc(zep, hod);
+ u3_noun pro;
+
+ u3t_push(tac);
+#if 0
+ {
+ static int low_i;
+
+ if ( !low_i ) {
+ low_i = 1;
+ if ( 0 == (u3R->pro.nox_d % 65536ULL) ) {
+ if ( c3__spot == zep ) {
+ u3l_log("spot %d/%d : %d/%d",
+ u3h(u3h(u3t(hod))),
+ u3t(u3h(u3t(hod))),
+ u3h(u3t(u3t(hod))),
+ u3t(u3t(u3t(hod))));
+ }
+ }
+ low_i = 0;
+ }
+ }
+#endif
+ pro = _n_nock_on(bus, nex);
+ u3t_drop();
+
+ return pro;
+ }
+
+ case c3__live: {
+ if ( c3y == u3ud(hod) ) {
+ u3t_off(noc_o);
+ u3t_heck(hod);
+ u3t_on(noc_o);
+ } else {
+ u3z(hod);
+ }
+ return _n_nock_on(bus, nex);
+ }
+
+ case c3__slog: {
+ if ( !(u3C.wag_w & u3o_quiet) ) {
+ u3t_off(noc_o);
+ u3t_slog(hod);
+ u3t_on(noc_o);
+ }
+ return _n_nock_on(bus, nex);
+ }
+
+ case c3__germ: {
+ u3_noun pro = _n_nock_on(bus, nex);
+
+ if ( c3y == u3r_sing(pro, hod) ) {
+ u3z(pro); return hod;
+ } else {
+ u3z(hod); return pro;
+ }
+ }
+
+ case c3__fast: {
+ u3_noun pro = _n_nock_on(bus, nex);
+
+ u3t_off(noc_o);
+ u3j_mine(hod, u3k(pro));
+ u3t_on(noc_o);
+
+ return pro;
+ }
+
+ case c3__memo: {
+ u3z(hod);
+#if 0
+ return _n_nock_on(bus, nex);
+#else
+ {
+ u3_noun pro = u3z_find_2(144 + c3__nock, bus, nex);
+
+ if ( pro != u3_none ) {
+ u3z(bus); u3z(nex);
+ return pro;
+ }
+ pro = _n_nock_on(u3k(bus), u3k(nex));
+
+ if ( &(u3H->rod_u) != u3R ) {
+ u3z_save_2(144 + c3__nock, bus, nex, pro);
+ }
+
+ u3z(bus); u3z(nex);
+
+ return pro;
+ }
+#endif
+ }
+
+ case c3__sole: {
+ u3z(hod);
+ {
+ u3_noun pro = _n_nock_on(bus, nex);
+
+ // return u3z_uniq(pro);
+ return pro;
+ }
+ }
+ }
+}
+
+/* _n_nock_on(): produce .*(bus fol). Do not virtualize.
+*/
+static u3_noun
+_n_nock_on(u3_noun bus, u3_noun fol)
+{
+ u3_noun hib, gal;
+
+ while ( 1 ) {
+ hib = u3h(fol);
+ gal = u3t(fol);
+
+#ifdef U3_CPU_DEBUG
+ u3R->pro.nox_d += 1;
+#endif
+
+ if ( c3y == u3du(hib) ) {
+ u3_noun poz, riv;
+
+ poz = _n_nock_on(u3k(bus), u3k(hib));
+ riv = _n_nock_on(bus, u3k(gal));
+
+ u3a_lose(fol);
+ return u3i_cell(poz, riv);
+ }
+ else switch ( hib ) {
+ default: return u3m_bail(c3__exit);
+
+ case 0: {
+ if ( c3n == u3ud(gal) ) {
+ return u3m_bail(c3__exit);
+ }
+ else {
+ u3_noun pro = u3k(u3at(gal, bus));
+
+ u3a_lose(bus); u3a_lose(fol);
+ return pro;
+ }
+ }
+ u3_assert(!"not reached");
+
+ case 1: {
+ u3_noun pro = u3k(gal);
+
+ u3a_lose(bus); u3a_lose(fol);
+ return pro;
+ }
+ u3_assert(!"not reached");
+
+ case 2: {
+ u3_noun nex = _n_nock_on(u3k(bus), u3k(u3t(gal)));
+ u3_noun seb = _n_nock_on(bus, u3k(u3h(gal)));
+
+ u3a_lose(fol);
+ bus = seb;
+ fol = nex;
+ continue;
+ }
+ u3_assert(!"not reached");
+
+ case 3: {
+ u3_noun gof, pro;
+
+ gof = _n_nock_on(bus, u3k(gal));
+ pro = u3du(gof);
+
+ u3a_lose(gof); u3a_lose(fol);
+ return pro;
+ }
+ u3_assert(!"not reached");
+
+ case 4: {
+ u3_noun gof, pro;
+
+ gof = _n_nock_on(bus, u3k(gal));
+ pro = u3i_vint(gof);
+
+ u3a_lose(fol);
+ return pro;
+ }
+ u3_assert(!"not reached");
+
+ case 5: {
+ u3_noun wim = _n_nock_on(bus, u3k(gal));
+ u3_noun pro = u3r_sing(u3h(wim), u3t(wim));
+
+ u3a_lose(wim); u3a_lose(fol);
+ return pro;
+ }
+ u3_assert(!"not reached");
+
+ case 6: {
+ u3_noun b_gal, c_gal, d_gal;
+
+ u3x_trel(gal, &b_gal, &c_gal, &d_gal);
+ {
+ u3_noun tys = _n_nock_on(u3k(bus), u3k(b_gal));
+ u3_noun nex;
+
+ if ( 0 == tys ) {
+ nex = u3k(c_gal);
+ } else if ( 1 == tys ) {
+ nex = u3k(d_gal);
+ } else return u3m_bail(c3__exit);
+
+ u3a_lose(fol);
+ fol = nex;
+ continue;
+ }
+ }
+ u3_assert(!"not reached");
+
+ case 7: {
+ u3_noun b_gal, c_gal;
+
+ u3x_cell(gal, &b_gal, &c_gal);
+ {
+ u3_noun bod = _n_nock_on(bus, u3k(b_gal));
+ u3_noun nex = u3k(c_gal);
+
+ u3a_lose(fol);
+ bus = bod;
+ fol = nex;
+ continue;
+ }
+ }
+ u3_assert(!"not reached");
+
+ case 8: {
+ u3_noun b_gal, c_gal;
+
+ u3x_cell(gal, &b_gal, &c_gal);
+ {
+ u3_noun heb = _n_nock_on(u3k(bus), u3k(b_gal));
+ u3_noun bod = u3nc(heb, bus);
+ u3_noun nex = u3k(c_gal);
+
+ u3a_lose(fol);
+ bus = bod;
+ fol = nex;
+ continue;
+ }
+ }
+ u3_assert(!"not reached");
+
+ case 9: {
+ u3_noun b_gal, c_gal;
+
+ u3x_cell(gal, &b_gal, &c_gal);
+ {
+ u3_noun seb = _n_nock_on(bus, u3k(c_gal));
+ u3_noun pro;
+
+ u3t_off(noc_o);
+ pro = u3j_kick(seb, b_gal);
+ u3t_on(noc_o);
+
+ if ( u3_none != pro ) {
+ u3a_lose(fol);
+ return pro;
+ }
+ else {
+ if ( c3n == u3ud(b_gal) ) {
+ return u3m_bail(c3__exit);
+ }
+ else {
+ u3_noun nex = u3k(u3at(b_gal, seb));
+
+ u3a_lose(fol);
+ bus = seb;
+ fol = nex;
+ continue;
+ }
+ }
+ }
+ }
+ u3_assert(!"not reached");
+
+ case 10: {
+ u3_noun p_gal, q_gal;
+
+ u3x_cell(gal, &p_gal, &q_gal);
+ {
+ u3_noun zep, hod, nex;
+
+ if ( c3y == u3du(p_gal) ) {
+ u3_noun b_gal = u3h(p_gal);
+ u3_noun c_gal = u3t(p_gal);
+ u3_noun d_gal = q_gal;
+
+ zep = u3k(b_gal);
+ hod = _n_nock_on(u3k(bus), u3k(c_gal));
+ nex = u3k(d_gal);
+ }
+ else {
+ u3_noun b_gal = p_gal;
+ u3_noun c_gal = q_gal;
+
+ zep = u3k(b_gal);
+ hod = u3_nul;
+ nex = u3k(c_gal);
+ }
+
+ u3a_lose(fol);
+ return _n_hint(zep, hod, bus, nex);
+ }
+ }
+
+ case 11: {
+ u3_noun ref = _n_nock_on(u3k(bus), u3k(u3h(gal)));
+ u3_noun gof = _n_nock_on(bus, u3k(u3t(gal)));
+ u3_noun val;
+
+ u3t_off(noc_o);
+ val = u3m_soft_esc(u3k(ref), u3k(gof));
+ u3t_on(noc_o);
+
+ if ( !_(u3du(val)) ) {
+ u3m_bail(u3nt(1, gof, 0));
+ }
+ if ( !_(u3du(u3t(val))) ) {
+ //
+ // replace with proper error stack push
+ //
+ u3t_push(u3nt(c3__hunk, ref, gof));
+ return u3m_bail(c3__exit);
+ }
+ else {
+ u3_noun pro;
+
+ u3z(ref);
+ u3z(gof);
+ u3z(fol);
+ pro = u3k(u3t(u3t(val)));
+ u3z(val);
+
+ return pro;
+ }
+ }
+ u3_assert(!"not reached");
+ }
+ }
+}
+#endif
+
+// Several opcodes "overflow" (from byte to short index) to their successor, so
+// order can matter here.
+// Note that we use an X macro (https://en.wikipedia.org/wiki/X_Macro) to unify
+// the opcode's enum name, string representation, and computed goto into a
+// single structure.
+#define OPCODES \
+ /* non-nock bytecodes */ \
+ X(HALT, "halt", &&do_halt), /* 0: terminator, end of bytcode program */ \
+ X(BAIL, "bail", &&do_bail), /* 1: deterministic crash */ \
+ /* stack manipulation */ \
+ X(COPY, "copy", &&do_copy), /* 2 */ \
+ X(SWAP, "swap", &&do_swap), /* 3 */ \
+ X(TOSS, "toss", &&do_toss), /* 4 */ \
+ /* auto-cons */ \
+ X(AUTO, "auto", &&do_auto), /* 5: kept */ \
+ X(AULT, "ault", &&do_ault), /* 6: lost */ \
+ /* general purposes */ \
+ X(SNOC, "snoc", &&do_snoc), /* 7: keep */ \
+ X(SNOL, "snol", &&do_snol), /* 8: lose */ \
+ /* nock 0: head */ \
+ X(HEAD, "head", &&do_head), /* 9: keep */ \
+ X(HELD, "held", &&do_held), /* 10: lose */ \
+ /* nock 0: tail */ \
+ X(TAIL, "tail", &&do_tail), /* 11: keep */ \
+ X(TALL, "tall", &&do_tall), /* 12: lose */ \
+ /* nock 0: fragment (keep) */ \
+ X(FABK, "fabk", &&do_fabk), /* 13: c3_y */ \
+ X(FASK, "fask", &&do_fask), /* 14: c3_s */ \
+ X(FIBK, "fibk", &&do_fibk), /* 15: c3_y */ \
+ X(FISK, "fisk", &&do_fisk), /* 16: c3_s */ \
+ /* nock 0: fragment (lose) */ \
+ X(FABL, "fabl", &&do_fabl), /* 17: c3_y */ \
+ X(FASL, "fasl", &&do_fasl), /* 18: c3_s */ \
+ X(FIBL, "fibl", &&do_fibl), /* 19: c3_y */ \
+ X(FISL, "fisl", &&do_fisl), /* 20: c3_s */ \
+ /* nock 1: literal (keep) */ \
+ X(LIT0, "lit0", &&do_lit0), /* 21: a literal 0 */ \
+ X(LIT1, "lit1", &&do_lit1), /* 22: a literal 1 */ \
+ X(LITB, "litb", &&do_litb), /* 23: c3_y */ \
+ X(LITS, "lits", &&do_lits), /* 24: c3_s */ \
+ X(LIBK, "libk", &&do_libk), /* 25: c3_y */ \
+ X(LISK, "lisk", &&do_lisk), /* 26: c3_s */ \
+ /* nock 1: literal (lose) */ \
+ X(LIL0, "lil0", &&do_lil0), /* 27: a literal 0 */ \
+ X(LIL1, "lil1", &&do_lil1), /* 28: a literal 1 */ \
+ X(LILB, "lilb", &&do_lilb), /* 29: c3_y */ \
+ X(LILS, "lils", &&do_lils), /* 30: c3_s */ \
+ X(LIBL, "libl", &&do_libl), /* 31: c3_y */ \
+ X(LISL, "lisl", &&do_lisl), /* 32: c3_s */ \
+ /* nock 2: nock */ \
+ X(NOLK, "nolk", &&do_nolk), /* 33, lost */ \
+ X(NOCT, "noct", &&do_noct), /* 34, tail */ \
+ X(NOCK, "nock", &&do_nock), /* 35, kept */ \
+ /* nock 3 & 4 */ \
+ X(DEEP, "deep", &&do_deep), /* 36 */ \
+ X(BUMP, "bump", &&do_bump), /* 37 */ \
+ /* nock 5: equality */ \
+ X(SAM0, "sam0", &&do_sam0), /* 38: test that it is equal to 0 */ \
+ X(SAM1, "sam1", &&do_sam1), /* 39: test that it is equal to 1 */ \
+ X(SAMB, "samb", &&do_samb), /* 40: test equality for vars size c3_b */ \
+ X(SAMS, "sams", &&do_sams), /* 41: test equality for vars size c3_s */ \
+ X(SANB, "sanb", &&do_sanb), /* 42: test equality for vars size c3_b */ \
+ X(SANS, "sans", &&do_sans), /* 43: test equality for vars size c3_s */ \
+ X(SAME, "same", &&do_same), /* 44 */ \
+ X(SALM, "salm", &&do_salm), /* 45 */ \
+ X(SAMC, "samc", &&do_samc), /* 46 */ \
+ /* related to nock 6: unconditional skips */ \
+ X(SBIP, "sbip", &&do_sbip), /* 47: c3_b */ \
+ X(SIPS, "sips", &&do_sips), /* 48: c3_s */ \
+ X(SWIP, "swip", &&do_swip), /* 49: c3_l */ \
+ /* related to nock 6: conditional skips */ \
+ X(SBIN, "sbin", &&do_sbin), /* 50: c3_b */ \
+ X(SINS, "sins", &&do_sins), /* 51: c3_s */ \
+ X(SWIN, "swin", &&do_swin), /* 52: c3_l */ \
+ /* nock 9 */ \
+ X(KICB, "kicb", &&do_kicb), /* 53: c3_b */ \
+ X(KICS, "kics", &&do_kics), /* 54: c3_s */ \
+ X(TICB, "ticb", &&do_ticb), /* 55: c3_b */ \
+ X(TICS, "tics", &&do_tics), /* 56: c3_s */ \
+ /* nock 12: scry (only defined in arvo, not in base nock spec) */ \
+ X(WILS, "wils", &&do_wils), /* 57 */ \
+ X(WISH, "wish", &&do_wish), /* 58 */ \
+ /* nock 11: hint processing */ \
+ X(BUSH, "bush", &&do_bush), /* 59: c3_b */ \
+ X(SUSH, "sush", &&do_sush), /* 60: c3_s */ \
+ X(DROP, "drop", &&do_drop), /* 61 */ \
+ X(HECK, "heck", &&do_heck), /* 62 */ \
+ X(SLOG, "slog", &&do_slog), /* 63 */ \
+ /* nock 11: fast (keep) */ \
+ X(BAST, "bast", &&do_bast), /* 64: c3_b */ \
+ X(SAST, "sast", &&do_sast), /* 65: c3_s */ \
+ /* nock 11: fast (lost) */ \
+ X(BALT, "balt", &&do_balt), /* 66: c3_b */ \
+ X(SALT, "salt", &&do_salt), /* 67: c3_s */ \
+ /* nock 11: memo (keep) */ \
+ X(SKIB, "skib", &&do_skib), /* 68: c3_b */ \
+ X(SKIS, "skis", &&do_skis), /* 69: c3_s */ \
+ /* nock 11: memo (lose) */ \
+ X(SLIB, "slib", &&do_slib), /* 70: c3_b */ \
+ X(SLIS, "slis", &&do_slis), /* 71: c3_s */ \
+ X(SAVE, "save", &&do_save), /* 72 */ \
+ /* nock 11: before formula */ \
+ X(HILB, "hilb", &&do_hilb), /* 73: atomic, byte */ \
+ X(HILS, "hils", &&do_hils), /* 74: atomic, short */ \
+ X(HINB, "hinb", &&do_hinb), /* 75: arbitrary, byte */ \
+ X(HINS, "hins", &&do_hins), /* 76: arbitrary, short */ \
+ /* nock 11: after formula */ \
+ X(HILK, "hilk", &&do_hilk), /* 77: atomic, keep */ \
+ X(HILL, "hill", &&do_hill), /* 78: atomic, lose */ \
+ X(HINK, "hink", &&do_hink), /* 79: arbitrary, keep */ \
+ X(HINL, "hinl", &&do_hinl), /* 80: arbitrary, lose */ \
+ /* nock 10 */ \
+ X(MUTH, "muth", &&do_muth), /* 81 */ \
+ X(KUTH, "kuth", &&do_kuth), /* 82 */ \
+ X(MUTT, "mutt", &&do_mutt), /* 83 */ \
+ X(KUTT, "kutt", &&do_kutt), /* 84 */ \
+ X(MUSM, "musm", &&do_musm), /* 85 */ \
+ X(KUSM, "kusm", &&do_kusm), /* 86 */ \
+ X(MUTB, "mutb", &&do_mutb), /* 87: c3_b */ \
+ X(MUTS, "muts", &&do_muts), /* 88: c3_s */ \
+ X(MITB, "mitb", &&do_mitb), /* 89: c3_b */ \
+ X(MITS, "mits", &&do_mits), /* 90: c3_s */ \
+ X(KUTB, "kutb", &&do_kutb), /* 91: c3_b */ \
+ X(KUTS, "kuts", &&do_kuts), /* 92: c3_s */ \
+ X(KITB, "kitb", &&do_kitb), /* 93: c3_b */ \
+ X(KITS, "kits", &&do_kits), /* 94: c3_s */ \
+ X(LAST, NULL, NULL), /* 95 */
+
+// Opcodes. Define X to select the enum name from OPCODES.
+#define X(opcode, name, indirect_jump) opcode
+enum { OPCODES };
+#undef X
+
+/* _n_arg(): return the size (in bytes) of an opcode's argument
+ */
+static inline c3_y
+_n_arg(c3_y cod_y)
+{
+ switch ( cod_y ) {
+ case FABK: case FABL: case FIBL: case FIBK:
+ case LILB: case LITB: case LIBL: case LIBK:
+ case SAMB: case SANB: case SBIP: case SBIN:
+ case SLIB: case SKIB: case KICB: case TICB:
+ case BUSH: case BAST: case BALT:
+ case MUTB: case KUTB: case MITB: case KITB:
+ case HILB: case HINB:
+ return sizeof(c3_y);
+
+ case FASK: case FASL: case FISL: case FISK:
+ case LILS: case LITS: case LISL: case LISK:
+ case SAMS: case SANS: case SIPS: case SINS:
+ case SLIS: case SKIS: case KICS: case TICS:
+ case SUSH: case SAST: case SALT:
+ case MUTS: case KUTS: case MITS: case KITS:
+ case HILS: case HINS:
+ return sizeof(c3_s);
+
+ case SWIP: case SWIN:
+ return sizeof(c3_l);
+
+ default:
+ u3_assert( cod_y < LAST );
+ return 0;
+ }
+}
+
+
+/* _n_melt(): measure space for list of ops (from _n_comp) */
+static u3_noun
+_n_melt(u3_noun ops, c3_w* byc_w, c3_w* cal_w,
+ c3_w* reg_w, c3_w* lit_w, c3_w* mem_w)
+{
+ c3_w len_w = u3qb_lent(ops),
+ i_w = len_w - 1,
+ a_w;
+ c3_y cod_y;
+ c3_y* siz_y = u3a_malloc(len_w);
+ u3_noun op, sip = u3_nul;
+
+ while ( u3_nul != ops ) {
+ op = u3h(ops);
+ if ( c3n == u3du(op) ) {
+ switch ( op ) {
+ default:
+ siz_y[i_w] = 1;
+ break;
+
+ case BAST: case BALT:
+ a_w = (*reg_w)++;
+ if ( a_w <= 0xFF ) {
+ siz_y[i_w] = 2;
+ }
+ else if ( a_w <= 0xFFFF ) {
+ siz_y[i_w] = 3;
+ }
+ else {
+ fprintf(stderr, "_n_melt(): over 2^16 registration sites.\r\n");
+ u3_assert(0);
+ }
+ break;
+ }
+ }
+ else {
+ cod_y = u3h(op);
+
+ switch ( cod_y ) {
+ default:
+ siz_y[i_w] = 1 + _n_arg(cod_y);
+ break;
+
+ case SBIP: case SBIN: {
+ c3_l tot_l = 0,
+ sip_l = u3t(op);
+ c3_w j_w, k_w = i_w;
+ for ( j_w = 0; j_w < sip_l; ++j_w ) {
+ tot_l += siz_y[++k_w];
+ }
+ sip = u3nc(tot_l, sip);
+ siz_y[i_w] = tot_l <= 0xFF ? 2 : tot_l <= 0xFFFF ? 3 : 5;
+ break;
+ }
+
+ case SKIB: case SLIB: {
+ c3_l tot_l = 0,
+ sip_l = u3h(u3t(u3t(op)));
+ c3_w j_w, k_w = i_w;
+ for ( j_w = 0; j_w < sip_l; ++j_w ) {
+ tot_l += siz_y[++k_w];
+ }
+ sip = u3nc(tot_l, sip);
+ a_w = (*mem_w)++;
+ if ( a_w <= 0xFF ) {
+ siz_y[i_w] = 2;
+ }
+ else if ( a_w <= 0xFFFF ) {
+ siz_y[i_w] = 3;
+ }
+ else {
+ fprintf(stderr, "_n_melt(): over 2^16 memos.\r\n");
+ u3_assert(0);
+ }
+ break;
+ }
+
+ case SIPS: case SINS: case SWIP: case SWIN:
+ case SAST: case SALT: case KICS: case TICS:
+ case FISK: case FISL: case SUSH: case SANS:
+ case LISL: case LISK: case SKIS: case SLIS:
+ case HILS: case HINS:
+ u3_assert(0); //overflows
+ break;
+
+ case KICB: case TICB:
+ a_w = (*cal_w)++;
+ if ( a_w <= 0xFF ) {
+ siz_y[i_w] = 2;
+ }
+ else if ( a_w <= 0xFFFF ) {
+ siz_y[i_w] = 3;
+ }
+ else {
+ fprintf(stderr, "_n_melt(): over 2^16 call sites.\r\n");
+ u3_assert(0);
+ }
+ break;
+
+ case BUSH: case FIBK: case FIBL:
+ case SANB: case LIBL: case LIBK:
+ case KITB: case MITB:
+ case HILB: case HINB:
+ a_w = (*lit_w)++;
+ if ( a_w <= 0xFF ) {
+ siz_y[i_w] = 2;
+ }
+ else if ( a_w <= 0xFFFF ) {
+ siz_y[i_w] = 3;
+ }
+ else {
+ fprintf(stderr, "_n_melt(): over 2^16 literals.\r\n");
+ u3_assert(0);
+ }
+ break;
+ }
+ }
+
+ *(byc_w) += siz_y[i_w--];
+ ops = u3t(ops);
+ }
+
+ u3a_free(siz_y);
+ return u3kb_flop(sip);
+}
+
+/* _n_prog_dat(): return pointer to program's data segment
+ */
+static void*
+_n_prog_dat(u3n_prog* pog_u)
+{
+ return ((void*) pog_u) + sizeof(u3n_prog);
+}
+
+/* _n_prog_new(): allocate and set up pointers for u3n_prog
+ */
+static u3n_prog*
+_n_prog_new(c3_w byc_w, c3_w cal_w,
+ c3_w reg_w, c3_w lit_w, c3_w mem_w)
+{
+ c3_w cab_w = (sizeof(u3j_site) * cal_w),
+ reb_w = (sizeof(u3j_rite) * reg_w),
+ lib_w = (sizeof(u3_noun) * lit_w),
+ meb_w = (sizeof(u3n_memo) * mem_w),
+ pad_w = (8 - byc_w % 8) % 8,
+ pod_w = lit_w % 2,
+ ped_w = mem_w % 2,
+ dat_w = byc_w + cab_w + reb_w + lib_w + meb_w + pad_w +
+ (pod_w * sizeof(u3_noun)) + (ped_w * sizeof(u3n_memo));
+
+ u3n_prog* pog_u = u3a_malloc(sizeof(u3n_prog) + dat_w);
+ pog_u->byc_u.own_o = c3y;
+ pog_u->byc_u.len_w = byc_w;
+ pog_u->byc_u.ops_y = (c3_y*) _n_prog_dat(pog_u);
+
+ pog_u->lit_u.len_w = lit_w;
+ pog_u->lit_u.non = (u3_noun*) (pog_u->byc_u.ops_y + pog_u->byc_u.len_w + pad_w);
+
+ pog_u->mem_u.len_w = mem_w;
+ pog_u->mem_u.sot_u = (u3n_memo*) (pog_u->lit_u.non + pog_u->lit_u.len_w + pod_w);
+
+ pog_u->cal_u.len_w = cal_w;
+ pog_u->cal_u.sit_u = (u3j_site*) (pog_u->mem_u.sot_u + pog_u->mem_u.len_w + ped_w);
+
+ pog_u->reg_u.len_w = reg_w;
+ pog_u->reg_u.rit_u = (u3j_rite*) (pog_u->cal_u.sit_u + pog_u->cal_u.len_w);
+
+ return pog_u;
+}
+
+/* _n_prog_old(): as _n_prog_new(),
+ * but leech off senior program's data segment
+ */
+static u3n_prog*
+_n_prog_old(u3n_prog* sep_u)
+{
+ c3_w cab_w = sizeof(u3j_site) * sep_u->cal_u.len_w,
+ reb_w = sizeof(u3j_rite) * sep_u->reg_u.len_w,
+ lib_w = sizeof(u3_noun) * sep_u->lit_u.len_w,
+ meb_w = sizeof(u3n_memo) * sep_u->mem_u.len_w,
+ pod_w = sep_u->lit_u.len_w % 2,
+ ped_w = sep_u->mem_u.len_w % 2,
+ dat_w = cab_w + reb_w + lib_w + meb_w +
+ (pod_w * sizeof(u3_noun)) + (ped_w * sizeof(u3n_memo));
+
+ u3n_prog* pog_u = u3a_malloc(sizeof(u3n_prog) + dat_w);
+ pog_u->byc_u.own_o = c3n;
+ pog_u->byc_u.len_w = sep_u->byc_u.len_w;
+ pog_u->byc_u.ops_y = sep_u->byc_u.ops_y;
+
+ pog_u->lit_u.len_w = sep_u->lit_u.len_w;
+ pog_u->lit_u.non = (u3_noun*) _n_prog_dat(pog_u);
+
+ pog_u->mem_u.len_w = sep_u->mem_u.len_w;
+ pog_u->mem_u.sot_u = (u3n_memo*) (pog_u->lit_u.non + pog_u->lit_u.len_w + pod_w);
+
+ pog_u->cal_u.len_w = sep_u->cal_u.len_w;
+ pog_u->cal_u.sit_u = (u3j_site*) (pog_u->mem_u.sot_u + pog_u->mem_u.len_w + ped_w);
+
+ pog_u->reg_u.len_w = sep_u->reg_u.len_w;
+ pog_u->reg_u.rit_u = (u3j_rite*) (pog_u->cal_u.sit_u + pog_u->cal_u.len_w);
+
+ memcpy(pog_u->lit_u.non, sep_u->lit_u.non, dat_w);
+ return pog_u;
+}
+
+/* _n_prog_asm_inx(): write an index to the bytestream with overflow
+ */
+static void
+_n_prog_asm_inx(c3_y* buf_y, c3_w* i_w, c3_s inx_s, c3_y cod)
+{
+ if ( inx_s <= 0xFF ) {
+ buf_y[(*i_w)--] = (c3_y) (inx_s);
+ buf_y[*i_w] = (c3_y) cod;
+ }
+ else {
+ buf_y[(*i_w)--] = (c3_y) (inx_s >> 8);
+ buf_y[(*i_w)--] = (c3_y) (inx_s);
+ // the short-index versions of these opcodes must immediately
+ // follow the byte-index versions because of this convention
+ buf_y[(*i_w)] = cod + 1;
+ }
+}
+
+/* _n_prog_asm(): assemble list of ops (from _n_comp) into u3n_prog
+ */
+static void
+_n_prog_asm(u3_noun ops, u3n_prog* pog_u, u3_noun sip)
+{
+ u3_noun top = ops;
+ c3_y* buf_y = pog_u->byc_u.ops_y;
+ c3_s lit_s = 0,
+ cal_s = 0,
+ mem_s = 0,
+ reg_s = 0;
+ c3_w i_w = pog_u->byc_u.len_w-1;
+
+ buf_y[i_w] = HALT;
+
+ while ( i_w-- > 0 ) {
+ u3_noun op = u3h(ops);
+ if ( c3y == u3ud(op) ) {
+ switch ( op ) {
+ default:
+ buf_y[i_w] = (c3_y) op;
+ break;
+
+ /* registration site index args */
+ case BAST: case BALT: {
+ _n_prog_asm_inx(buf_y, &i_w, reg_s, op);
+ u3j_rite* rit_u = &(pog_u->reg_u.rit_u[reg_s++]);
+ rit_u->own_o = c3n;
+ rit_u->clu = u3_none;
+ rit_u->fin_p = 0;
+ break;
+ }
+ }
+ }
+ else {
+ u3_noun cod = u3h(op);
+ switch ( cod ) {
+ default:
+ u3_assert(0);
+ return;
+
+ /* memo index args */
+ case SKIB: case SLIB: {
+ u3n_memo* mem_u;
+ c3_l sip_l = u3h(sip);
+ u3_noun tmp = sip;
+ sip = u3k(u3t(sip));
+ u3z(tmp);
+ _n_prog_asm_inx(buf_y, &i_w, mem_s, cod);
+ mem_u = &(pog_u->mem_u.sot_u[mem_s++]);
+ mem_u->sip_l = sip_l;
+ // [op_y, cid, mem_w, nef]
+ mem_u->key = u3k(u3t(u3t(u3t(op))));
+ mem_u->cid = u3h(u3t(op));
+ break;
+ }
+
+ /* skips */
+ case SBIP: case SBIN: {
+ c3_l sip_l = u3h(sip);
+ u3_noun tmp = sip;
+ sip = u3k(u3t(sip));
+ u3z(tmp);
+ if ( sip_l <= 0xFF ) {
+ buf_y[i_w--] = (c3_y) sip_l;
+ buf_y[i_w] = (c3_y) cod;
+ }
+ else if ( sip_l <= 0xFFFF ) {
+ buf_y[i_w--] = (c3_y) (sip_l >> 8);
+ buf_y[i_w--] = (c3_y) sip_l;
+ buf_y[i_w] = (c3_y) cod + 1;
+ }
+ else {
+ buf_y[i_w--] = (c3_y) (sip_l >> 24);
+ buf_y[i_w--] = (c3_y) (sip_l >> 16);
+ buf_y[i_w--] = (c3_y) (sip_l >> 8);
+ buf_y[i_w--] = (c3_y) sip_l;
+ buf_y[i_w] = (c3_y) cod + 2;
+ }
+ break;
+ }
+
+ /* 8-bit direct args */
+ case FABK: case FABL:
+ case LITB: case LILB:
+ case MUTB: case KUTB:
+ case SAMB:
+ buf_y[i_w--] = (c3_y) u3t(op);
+ buf_y[i_w] = (c3_y) cod;
+ break;
+
+ /* 16-bit direct args */
+ case FASK: case FASL:
+ case LILS: case LITS:
+ case MUTS: case KUTS:
+ case SAMS: case SIPS: case SINS: {
+ c3_s off_s = u3t(op);
+ buf_y[i_w--] = (c3_y) (off_s >> 8);
+ buf_y[i_w--] = (c3_y) off_s;
+ buf_y[i_w] = (c3_y) cod;
+ break;
+ }
+
+ /* 31-bit direct args */
+ case SWIP: case SWIN: {
+ c3_w off_l = u3t(op);
+ buf_y[i_w--] = (c3_y) (off_l >> 24);
+ buf_y[i_w--] = (c3_y) (off_l >> 16);
+ buf_y[i_w--] = (c3_y) (off_l >> 8);
+ buf_y[i_w--] = (c3_y) off_l;
+ buf_y[i_w] = (c3_y) cod;
+ break;
+ }
+
+ /* literal index args */
+ case FIBK: case FIBL:
+ case LIBK: case LIBL:
+ case BUSH: case SANB:
+ case KITB: case MITB:
+ case HILB: case HINB:
+ _n_prog_asm_inx(buf_y, &i_w, lit_s, cod);
+ pog_u->lit_u.non[lit_s++] = u3k(u3t(op));
+ break;
+
+ /* call site index args */
+ case TICB: case KICB: {
+ _n_prog_asm_inx(buf_y, &i_w, cal_s, cod);
+ u3j_site* sit_u = &(pog_u->cal_u.sit_u[cal_s++]);
+ sit_u->axe = u3k(u3t(op));
+ sit_u->pog_p = 0;
+ sit_u->bat = u3_none;
+ sit_u->bas = u3_none;
+ sit_u->loc = u3_none;
+ sit_u->lab = u3_none;
+ sit_u->jet_o = c3n;
+ sit_u->fon_o = c3n;
+ sit_u->cop_u = NULL;
+ sit_u->ham_u = NULL;
+ sit_u->fin_p = 0;
+ break;
+ }
+ }
+ }
+ ops = u3t(ops);
+ }
+ u3z(top);
+ // this assert will fail if we overflow a c3_w worth of instructions
+ u3_assert(u3_nul == ops);
+ // this is just a sanity check
+ u3_assert(u3_nul == sip);
+}
+
+/* _n_prog_from_ops(): new program from _n_comp() product
+ */
+static u3n_prog*
+_n_prog_from_ops(u3_noun ops)
+{
+ u3_noun sip;
+ u3n_prog* pog_u;
+ c3_w byc_w = 1, // HALT
+ cal_w = 0,
+ reg_w = 0,
+ lit_w = 0,
+ mem_w = 0;
+
+ sip = _n_melt(ops, &byc_w, &cal_w, &reg_w, &lit_w, &mem_w);
+ pog_u = _n_prog_new(byc_w, cal_w, reg_w, lit_w, mem_w);
+ _n_prog_asm(ops, pog_u, sip);
+ return pog_u;
+}
+
+#if 0
+/* _n_print_stack(): print out the cap stack up to a designated "empty"
+ * used only for debugging
+ */
+static void _n_print_stack(u3p(u3_noun) empty) {
+ c3_w cur_p = u3R->cap_p;
+ fprintf(stderr, "[");
+ int first = 1;
+ while ( cur_p != empty ) {
+ if ( first ) {
+ first = 0;
+ }
+ else {
+ fprintf(stderr, " ");
+ }
+ if ( c3y == u3a_is_north(u3R) ) {
+ fprintf(stderr, "%u", *(u3to(u3_noun, cur_p)));
+ cur_p++;
+ }
+ else {
+ fprintf(stderr, "%u", *(u3to(u3_noun, cur_p-1)));
+ cur_p--;
+ }
+ }
+ fprintf(stderr, "]\r\n");
+}
+#endif
+
+// Define X to select the opcode string representation from OPCODES.
+# define X(opcode, name, indirect_jump) name
+static c3_c* opcode_names[] = { OPCODES };
+# undef X
+
+/* _n_apen(): emit the instructions contained in src to dst
+ */
+static inline void
+_n_apen(u3_noun* dst, u3_noun src)
+{
+ *dst = u3kb_weld(src, *dst);
+}
+
+/* _n_emit(): emit a single instruction to ops
+ */
+static inline void
+_n_emit(u3_noun *ops, u3_noun op)
+{
+ *ops = u3nc(op, *ops);
+}
+
+static c3_w _n_comp(u3_noun*, u3_noun, c3_o, c3_o);
+
+/* _n_bint(): hint-processing helper for _n_comp.
+ * hif: hint-formula (first part of 11). RETAIN.
+ * nef: next-formula (second part of 11). RETAIN.
+ */
+static c3_w
+_n_bint(u3_noun* ops, u3_noun hif, u3_noun nef, c3_o los_o, c3_o tel_o)
+{
+ c3_w tot_w = 0;
+
+ if ( c3n == u3du(hif) ) {
+ // compile whitelisted atomic hints to dispatch protocol;
+ // compute and drop all others;
+ //
+ switch ( hif ) {
+ default: {
+ return _n_comp(ops, nef, los_o, tel_o);
+ }
+ case c3__cash:
+ case c3__xray:
+ case c3__meme:
+ case c3__nara:
+ case c3__hela:
+ case c3__bout: {
+ u3_noun fen = u3_nul;
+ c3_w nef_w = _n_comp(&fen, nef, los_o, c3n);
+ // add appropriate hind opcode
+ ++nef_w; _n_emit(&fen, ( c3y == los_o ) ? HILL : HILK);
+ // skip over the cleanup opcode
+ ++nef_w; _n_emit(&fen, u3nc(SBIP, 1));
+
+ // call hilt_fore
+ // HILB overflows to HILS
+ ++tot_w; _n_emit(ops, u3nc(HILB, u3nc(u3k(hif), u3k(nef))));
+ // if fore return c3n, skip fen
+ ++tot_w; _n_emit(ops, u3nc(SBIN, nef_w));
+ tot_w += nef_w; _n_apen(ops, fen);
+ // post-skip cleanup opcode
+ ++tot_w; _n_emit(ops, ( c3y == los_o ) ? TOSS : SWAP);
+ } break;
+ }
+ }
+ else {
+ u3_noun zep, hod;
+ u3x_cell(hif, &zep, &hod);
+
+ switch ( zep ) {
+ default: {
+ // compile whitelisted dynamic hints to dispatch protocol;
+ // compute and drop all others;
+ //
+ switch ( zep ) {
+ default: {
+ tot_w += _n_comp(ops, hod, c3n, c3n);
+ ++tot_w; _n_emit(ops, TOSS);
+ tot_w += _n_comp(ops, nef, los_o, tel_o);
+ } break;
+ case c3__xray:
+ case c3__meme:
+ case c3__nara:
+ case c3__hela:
+ case c3__spin:
+ case c3__bout: {
+ u3_noun fen = u3_nul;
+ c3_w nef_w = _n_comp(&fen, nef, los_o, c3n);
+ // add appropriate hind opcode
+ ++nef_w; _n_emit(&fen, ( c3y == los_o ) ? HINL : HINK);
+ // skip over the cleanup opcode
+ ++nef_w; _n_emit(&fen, u3nc(SBIP, 1));
+
+ // push clue
+ tot_w += _n_comp(ops, hod, c3n, c3n);
+ // call hint_fore
+ // HINB overflows to HINS
+ ++tot_w; _n_emit(ops, u3nc(HINB, u3nc(u3k(zep), u3k(nef))));
+ // if fore return c3n, skip fen
+ ++tot_w; _n_emit(ops, u3nc(SBIN, nef_w));
+ tot_w += nef_w; _n_apen(ops, fen);
+ // post-skip cleanup opcode
+ ++tot_w; _n_emit(ops, ( c3y == los_o ) ? TOSS : SWAP);
+ } break;
+ }
+ } break;
+
+ case c3__hunk:
+ case c3__lose:
+ case c3__mean:
+ case c3__spot:
+ tot_w += _n_comp(ops, hod, c3n, c3n);
+ ++tot_w; _n_emit(ops, u3nc(BUSH, zep)); // overflows to SUSH
+ tot_w += _n_comp(ops, nef, los_o, c3n);
+ ++tot_w; _n_emit(ops, DROP);
+ break;
+
+ case c3__live:
+ tot_w += _n_comp(ops, hod, c3n, c3n);
+ ++tot_w; _n_emit(ops, HECK);
+ tot_w += _n_comp(ops, nef, los_o, tel_o);
+ break;
+
+ case c3__slog:
+ tot_w += _n_comp(ops, hod, c3n, c3n);
+ ++tot_w; _n_emit(ops, SLOG);
+ tot_w += _n_comp(ops, nef, los_o, tel_o);
+ break;
+
+ // germ and sole are unused...
+
+ case c3__fast:
+ tot_w += _n_comp(ops, hod, c3n, c3n);
+ ++tot_w; _n_emit(ops, SWAP);
+ tot_w += _n_comp(ops, nef, los_o, c3n);
+ // overflows to SALT / SAST
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? BALT : BAST);
+ break;
+
+ case c3__memo: {
+ u3_noun mem = u3_nul;
+ c3_w mem_w = 0;
+ c3_y op_y;
+
+ tot_w += _n_comp(ops, hod, c3n, c3n);
+ ++tot_w; _n_emit(ops, TOSS);
+
+ mem_w += _n_comp(&mem, nef, c3y, c3n);
+ ++mem_w; _n_emit(&mem, SAVE);
+
+ op_y = (c3y == los_o) ? SLIB : SKIB; // overflows to SLIS / SKIS
+ u3z_cid cid = u3z_memo_toss;
+ {
+ u3_weak con = u3r_skip(hod);
+ if ( (u3_none != con) && (c3y == u3du(con)) ) {
+ cid = u3z_memo_keep;
+ }
+ }
+ ++tot_w; _n_emit(ops, u3nq(op_y, cid, mem_w, u3k(nef)));
+ tot_w += mem_w; _n_apen(ops, mem);
+ break;
+ }
+ }
+ }
+
+ return tot_w;
+}
+
+static c3_t
+_n_formulaic(u3_noun fol)
+{
+ u3_noun op, ar, a, b, c;
+ if ( c3n == u3r_cell(fol, &op, &ar) ) {
+ return 0;
+ }
+ if ( c3y == u3du(op) ) {
+ return _n_formulaic(op) && _n_formulaic(ar);
+ }
+ else switch ( op ) {
+ case 0:
+ return ( c3y == u3ud(ar) );
+ case 1:
+ return 1;
+ case 3:
+ case 4:
+ return _n_formulaic(ar);
+ case 2:
+ case 5:
+ case 7:
+ case 8:
+ case 12:
+ return (c3y == u3r_cell(ar, &a, &b))
+ && _n_formulaic(a) && _n_formulaic(b);
+ case 6: {
+ u3_noun lit;
+
+ if ( c3n == u3r_trel(ar, &a, &b, &c) || !_n_formulaic(a) ) {
+ return 0;
+ }
+
+ if ( c3n == u3r_safe(a, &lit) || u3_none == lit ) {
+ return _n_formulaic(b) || _n_formulaic(c);
+ }
+
+ switch (lit) {
+ case 0: return _n_formulaic(b);
+ case 1: return _n_formulaic(c);
+ default: return 0;
+ }
+ }
+ case 9:
+ return (c3y == u3r_cell(ar, &a, &b))
+ && (c3y == u3ud(a))
+ && _n_formulaic(b);
+ case 10:
+ if ( c3n == u3r_cell(ar, &a, &b) ) {
+ return 0;
+ }
+ if ( c3n == u3du(a) ) {
+ return 0;
+ }
+ if ( c3n == u3ud(u3h(a)) ) {
+ return 0;
+ }
+ return _n_formulaic(u3t(a)) && _n_formulaic(b);
+ case 11:
+ if ( c3n == u3r_cell(ar, &a, &b) ) {
+ return 0;
+ }
+ if ( !_n_formulaic(b) ) {
+ return 0;
+ }
+ if ( c3y == u3ud(a) ) {
+ return 1;
+ }
+ else {
+ return ( c3y == u3ud(u3h(a)) ) && _n_formulaic(u3t(a));
+ }
+ default:
+ return 0;
+ }
+}
+
+/* _n_comp(): compile nock formula to reversed opcode list
+ * ops is a pointer to a list (to be emitted to)
+ * fol is the nock formula to compile. RETAIN.
+ * los_o indicates whether we should remove our
+ * subject from the stack
+ * tel_o is yes if this formula is in tail position
+ * return: number of instructions added to the opcode list
+ */
+static c3_w
+_n_comp(u3_noun* ops, u3_noun fol, c3_o los_o, c3_o tel_o)
+{
+ c3_y op_y;
+ c3_w tot_w = 0;
+ u3_noun cod, arg, hed, tel;
+ u3x_cell(fol, &cod, &arg);
+ if ( c3y == u3du(cod) ) {
+ tot_w += _n_comp(ops, cod, c3n, c3n);
+ ++tot_w; _n_emit(ops, SWAP);
+ tot_w += _n_comp(ops, arg, los_o, c3n);
+ ++tot_w; _n_emit(ops, (c3y == los_o ) ? AULT : AUTO);
+ }
+ else switch ( cod ) {
+ case 0:
+ if ( c3n == u3ud(arg) ) {
+ u3m_bail(c3__exit);
+ return 0;
+ }
+ switch ( arg ) {
+ case 0:
+ ++tot_w; _n_emit(ops, BAIL);
+ break;
+ case 1:
+ if ( c3n == los_o ) {
+ ++tot_w; _n_emit(ops, COPY);
+ }
+ break;
+ case 2:
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? HELD : HEAD);
+ break;
+ case 3:
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? TALL : TAIL);
+ break;
+ default:
+ op_y = (c3y == los_o)
+ ? (arg <= 0xFF ? FABL : arg <= 0xFFFF ? FASL : FIBL) // overflows to FISL
+ : (arg <= 0xFF ? FABK : arg <= 0xFFFF ? FASK : FIBK); // overflows to FISK
+ ++tot_w; _n_emit(ops, u3nc(op_y, u3k(arg)));
+ break;
+ }
+ break;
+
+ case 1:
+ switch ( arg ) {
+ case 0:
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? LIL0 : LIT0);
+ break;
+ case 1:
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? LIL1 : LIT1);
+ break;
+ default:
+ op_y = (c3y == los_o)
+ ? (arg <= 0xFF ? LILB : arg <= 0xFFFF ? LILS : LIBL) // overflows to LISL
+ : (arg <= 0xFF ? LITB : arg <= 0xFFFF ? LITS : LIBK); // overflows to LISK
+ ++tot_w; _n_emit(ops, u3nc(op_y, u3k(arg)));
+ break;
+ }
+ break;
+
+ case 2:
+ u3x_cell(arg, &hed, &tel);
+ tot_w += _n_comp(ops, hed, c3n, c3n);
+ ++tot_w; _n_emit(ops, SWAP);
+ tot_w += _n_comp(ops, tel, los_o, c3n);
+ /* things in tail position replace (so, lose) top of stack,
+ * so NOCT "loses" and there is no non-losing version */
+ op_y = (c3y == tel_o) ? NOCT
+ : ((c3y == los_o) ? NOLK : NOCK);
+ ++tot_w; _n_emit(ops, op_y);
+ break;
+
+ case 3:
+ tot_w += _n_comp(ops, arg, los_o, c3n);
+ ++tot_w; _n_emit(ops, DEEP);
+ break;
+
+ case 4:
+ tot_w += _n_comp(ops, arg, los_o, c3n);
+ ++tot_w; _n_emit(ops, BUMP);
+ break;
+
+ case 5: {
+ u3x_cell(arg, &hed, &tel);
+
+ if ( c3n == u3du(hed) ) {
+ u3m_bail(c3__exit);
+ return 0;
+ }
+ else {
+ c3_t hec_t, tec_t;
+ hec_t = (1 == u3h(hed));
+ if ( c3n == u3du(tel) ) {
+ u3m_bail(c3__exit);
+ break;
+ }
+ else {
+ tec_t = (1 == u3h(tel));
+ }
+ if ( hec_t && tec_t ) {
+ if ( c3y == u3r_sing(u3t(hed), u3t(tel)) ) {
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? LIL0 : LIT0);
+ }
+ else {
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? LIL1 : LIT1);
+ }
+ }
+ else if ( !hec_t && !tec_t ) {
+ tot_w += _n_comp(ops, hed, c3n, c3n);
+ ++tot_w; _n_emit(ops, SWAP);
+ tot_w += _n_comp(ops, tel, los_o, c3n);
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? SALM : SAME);
+ }
+ else {
+ tot_w += _n_comp(ops, (hec_t ? tel : hed), los_o, c3n);
+ u3_noun lit = u3t(hec_t ? hed : tel);
+ switch ( lit ) {
+ case 0:
+ ++tot_w; _n_emit(ops, SAM0);
+ break;
+ case 1:
+ ++tot_w; _n_emit(ops, SAM1);
+ break;
+ default:
+ // overflows to SANS
+ op_y = lit <= 0xFF ? SAMB : lit <= 0xFFFF ? SAMS : SANB;
+ ++tot_w; _n_emit(ops, u3nc(op_y, u3k(lit)));
+ }
+ }
+ }
+ break;
+ }
+
+ case 6: {
+ u3_noun mid, lit;
+ u3x_trel(arg, &hed, &mid, &tel);
+ if ( c3y == u3r_safe(hed, &lit) && u3_none != lit ) {
+ switch ( lit ) {
+ case 0:
+ tot_w += _n_comp(ops, mid, los_o, tel_o);
+ break;
+
+ case 1:
+ tot_w += _n_comp(ops, tel, los_o, tel_o);
+ break;
+
+ default:
+ ++tot_w; _n_emit(ops, BAIL);
+ break;
+ }
+ }
+ else {
+ u3_noun yep = u3_nul,
+ nop = u3_nul;
+ c3_w yep_w, nop_w;
+ c3_t yep_t, nop_t;
+
+ tot_w += _n_comp(ops, hed, c3n, c3n);
+ yep_t = _n_formulaic(mid);
+ nop_t = _n_formulaic(tel);
+
+ if ( !yep_t && !nop_t ) {
+ u3m_bail(c3__exit);
+ break;
+ }
+
+ if ( yep_t ) {
+ yep_w = _n_comp(&yep, mid, los_o, tel_o);
+ }
+ else {
+ yep_w = 1; _n_emit(&yep, BAIL);
+ }
+
+ if ( nop_t ) {
+ nop_w = _n_comp(&nop, tel, los_o, tel_o);
+ }
+ else {
+ nop_w = 1; _n_emit(&nop, BAIL);
+ }
+
+ // SBIP and SBIN get sized during assembly
+ ++yep_w; _n_emit(&yep, u3nc(SBIP, nop_w));
+ ++tot_w; _n_emit(ops, u3nc(SBIN, yep_w));
+ tot_w += yep_w; _n_apen(ops, yep);
+ tot_w += nop_w; _n_apen(ops, nop);
+ }
+ break;
+ }
+
+ case 7:
+ u3x_cell(arg, &hed, &tel);
+ tot_w += _n_comp(ops, hed, los_o, c3n);
+ tot_w += _n_comp(ops, tel, c3y, tel_o);
+ break;
+
+ case 8:
+ u3x_cell(arg, &hed, &tel);
+ tot_w += _n_comp(ops, hed, c3n, c3n);
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? SNOL : SNOC);
+ tot_w += _n_comp(ops, tel, c3y, tel_o);
+ break;
+
+ case 9:
+ u3x_cell(arg, &hed, &tel);
+ if ( (1 == hed) || (3 == u3qc_cap(u3x_atom(hed))) ) {
+ u3_noun mac = u3nq(7, u3k(tel), 2, u3nt(u3nc(0, 1), 0, u3k(hed)));
+ tot_w += _n_comp(ops, mac, los_o, tel_o);
+ u3z(mac);
+ }
+ else {
+ tot_w += _n_comp(ops, tel, (c3y == tel_o ? c3y : los_o), c3n);
+ op_y = (c3y == tel_o) ? TICB : KICB; // overflows to TICS/KICS
+ ++tot_w; _n_emit(ops, u3nc(op_y, u3k(hed)));
+ }
+ break;
+
+ case 10: {
+ u3_noun axe, nef;
+ u3x_cell(arg, &hed, &tel);
+ u3x_cell(hed, &axe, &nef);
+ tot_w += _n_comp(ops, tel, c3n, c3n);
+ ++tot_w; _n_emit(ops, SWAP);
+ tot_w += _n_comp(ops, nef, los_o, c3n);
+
+ ++tot_w;
+ switch ( axe ) {
+ case 2:
+ _n_emit(ops, (c3y == los_o) ? MUTH : KUTH);
+ break;
+
+ case 3:
+ _n_emit(ops, (c3y == los_o) ? MUTT : KUTT);
+ break;
+
+ case u3x_sam:
+ _n_emit(ops, (c3y == los_o) ? MUSM : KUSM);
+ break;
+
+ default:
+ op_y = (c3y == los_o)
+ ? (axe <= 0xFF) ? MUTB : (axe <= 0xFFFF) ? MUTS : MITB // overflows to MITS
+ : (axe <= 0xFF) ? KUTB : (axe <= 0xFFFF) ? KUTS : KITB; // overflows to KITS
+ _n_emit(ops, u3nc(op_y, u3k(axe)));
+ break;
+ }
+ break;
+ }
+
+ case 11:
+ u3x_cell(arg, &hed, &tel);
+ tot_w += _n_bint(ops, hed, tel, los_o, tel_o);
+ break;
+
+ case 12:
+ u3x_cell(arg, &hed, &tel);
+ tot_w += _n_comp(ops, hed, c3n, c3n);
+ ++tot_w; _n_emit(ops, SWAP);
+ tot_w += _n_comp(ops, tel, los_o, c3n);
+ ++tot_w; _n_emit(ops, (c3y == los_o) ? WILS : WISH);
+ break;
+
+ default:
+ u3m_bail(c3__exit);
+ return 0;
+ }
+ return tot_w;
+}
+
+/* _n_push(): push a noun onto the stack. RETAIN
+ * mov: -1 north, 1 south
+ * off: 0 north, -1 south
+ */
+static inline void
+_n_push(c3_ys mov, c3_ys off, u3_noun a)
+{
+ u3R->cap_p += mov;
+
+ // XX switch to u3a_push()
+ //
+#ifndef U3_GUARD_PAGE
+ if ( 0 == off ) {
+ if( !(u3R->cap_p > u3R->hat_p) ) {
+ u3m_bail(c3__meme);
+ }
+ }
+ else {
+ if( !(u3R->cap_p < u3R->hat_p) ) {
+ u3m_bail(c3__meme);
+ }
+ }
+#endif
+
+ u3_noun* p = u3to(u3_noun, u3R->cap_p + off);
+ *p = a;
+}
+
+/* _n_peek(): pointer to noun at top of stack
+ * off: 0 north, -1 south
+ */
+static inline u3_noun*
+_n_peek(c3_ys off)
+{
+ return u3to(u3_noun, u3R->cap_p + off);
+}
+
+/* _n_peet(): address of the next-to-top of stack
+ * mov: -1 north, 1 south
+ * off: 0 north, -1 south
+ */
+static inline u3_noun*
+_n_peet(c3_ys mov, c3_ys off)
+{
+ return u3to(u3_noun, (u3R->cap_p - mov) + off);
+}
+
+/* _n_pop(): pop a noun from the cap stack
+ * mov: -1 north, 1 south
+ */
+static inline void
+_n_pop(c3_ys mov)
+{
+ u3R->cap_p -= mov;
+}
+
+/* _n_pep(): pop and return noun from the cap stack
+ * mov: -1 north, 1 south
+ * off: 0 north, -1 south
+ */
+static inline u3_noun
+_n_pep(c3_ys mov, c3_ys off)
+{
+ u3_noun r = *(_n_peek(off));
+ _n_pop(mov);
+ return r;
+}
+
+/* _n_toss(): pep and lose
+ */
+static inline void
+_n_toss(c3_ys mov, c3_ys off)
+{
+ u3z(_n_pep(mov, off));
+}
+
+/* _n_resh(): read a c3_s from the bytecode stream
+ */
+static inline c3_s
+_n_resh(c3_y* buf, c3_w* ip_w)
+{
+ c3_y les = buf[(*ip_w)++];
+ c3_y mos = buf[(*ip_w)++];
+ return les | (mos << 8);
+}
+
+/* _n_rewo(): read a c3_w from the bytecode stream.
+ */
+static inline c3_w
+_n_rewo(c3_y* buf, c3_w* ip_w)
+{
+ c3_y one = buf[(*ip_w)++],
+ two = buf[(*ip_w)++],
+ tre = buf[(*ip_w)++],
+ qua = buf[(*ip_w)++];
+ return one | (two << 8) | (tre << 16) | (qua << 24);
+}
+
+/* _n_swap(): swap two items on the top of the stack, return pointer to top
+ */
+static inline u3_noun*
+_n_swap(c3_ys mov, c3_ys off)
+{
+ u3_noun* top = _n_peek(off);
+ u3_noun* up = _n_peet(mov, off);
+ u3_noun tmp = *up;
+ *up = *top;
+ *top = tmp;
+ return top;
+}
+
+#ifdef VERBOSE_BYTECODE
+/* _n_print_byc(): print bytecode. used for debugging.
+ */
+static void
+_n_print_byc(c3_y* pog, c3_w her_w)
+{
+ c3_w ip_w = 0;
+ if ( her_w == 0 ) {
+ fprintf(stderr, "begin: {");
+ }
+ else {
+ fprintf(stderr, "resume: {");
+ }
+ int first = 1;
+ while ( pog[ip_w] ) {
+ if ( first ) {
+ first = 0;
+ }
+ else if (ip_w == her_w) {
+ fprintf(stderr, " [*]");
+ }
+ else {
+ fprintf(stderr, " ");
+ }
+ switch ( _n_arg(pog[ip_w]) ) {
+ case 0:
+ fprintf(stderr, "%s", opcode_names[pog[ip_w++]]);
+ break;
+
+ case 1:
+ fprintf(stderr, "[%s ", opcode_names[pog[ip_w++]]);
+ fprintf(stderr, "%u]", pog[ip_w++]);
+ break;
+
+ case 2:
+ fprintf(stderr, "[%s ", opcode_names[pog[ip_w++]]);
+ fprintf(stderr, "%u]", _n_resh(pog, &ip_w));
+ break;
+
+ case 4:
+ fprintf(stderr, "[%s", opcode_names[pog[ip_w++]]);
+ fprintf(stderr, "%u]", _n_rewo(pog, &ip_w));
+ break;
+ default:
+ u3_assert(0);
+ break;
+ }
+ }
+ fprintf(stderr, " halt}\r\n");
+}
+#endif
+
+/* _n_bite(): compile a nock formula to bytecode. RETAIN.
+ */
+static inline u3n_prog*
+_n_bite(u3_noun fol) {
+ u3_noun ops = u3_nul;
+ _n_comp(&ops, fol, c3y, c3y);
+ return _n_prog_from_ops(ops);
+}
+
+static inline c3_w
+_cn_of_prog(u3n_prog *pog_u)
+{
+ u3_post pog_p = u3of(u3n_prog, pog_u);
+ return pog_p >> u3a_vits;
+}
+
+static inline u3n_prog*
+_cn_to_prog(c3_w pog_w)
+{
+ u3_post pog_p = pog_w << u3a_vits;
+ return u3to(u3n_prog, pog_p);
+}
+
+/* _n_find(): return prog for given formula with prefix (u3_nul for none).
+ * RETAIN.
+ */
+static u3n_prog*
+_n_find(u3_noun pre, u3_noun fol)
+{
+ u3_noun key = u3nc(u3k(pre), u3k(fol));
+ u3_weak pog = u3h_git(u3R->byc.har_p, key);
+ if ( u3_none != pog ) {
+ u3z(key);
+ return _cn_to_prog(pog);
+ }
+ else if ( u3R != &u3H->rod_u ) {
+ u3a_road* rod_u = u3R;
+ while ( rod_u->par_p ) {
+ rod_u = u3to(u3a_road, rod_u->par_p);
+ pog = u3h_git(rod_u->byc.har_p, key);
+ if ( u3_none != pog ) {
+ c3_w i_w;
+ u3n_prog* old = _n_prog_old(_cn_to_prog(pog));
+ for ( i_w = 0; i_w < old->reg_u.len_w; ++i_w ) {
+ u3j_rite* rit_u = &(old->reg_u.rit_u[i_w]);
+ rit_u->own_o = c3n;
+ }
+ for ( i_w = 0; i_w < old->cal_u.len_w; ++i_w ) {
+ u3j_site* sit_u = &(old->cal_u.sit_u[i_w]);
+ sit_u->bat = u3_none;
+ sit_u->pog_p = 0;
+ sit_u->fon_o = c3n;
+ }
+ u3h_put(u3R->byc.har_p, key, _cn_of_prog(old));
+ u3z(key);
+ return old;
+ }
+ }
+ }
+
+ {
+ u3n_prog* gop = _n_bite(fol);
+ u3h_put(u3R->byc.har_p, key, _cn_of_prog(gop));
+ u3z(key);
+ return gop;
+ }
+}
+
+/* u3n_find(): return prog for given formula,
+ * split by key (u3_nul for no key). RETAIN.
+ */
+u3p(u3n_prog)
+u3n_find(u3_noun key, u3_noun fol)
+{
+ u3p(u3n_prog) pog_p;
+ u3t_on(noc_o);
+ pog_p = u3of(u3n_prog, _n_find(key, fol));
+ u3t_off(noc_o);
+ return pog_p;
+}
+
+/* _cn_prog_free(): free memory retained by program pog_u
+*/
+static void
+_cn_prog_free(u3n_prog* pog_u)
+{
+ c3_w dex_w;
+ for (dex_w = 0; dex_w < pog_u->lit_u.len_w; ++dex_w) {
+ u3z(pog_u->lit_u.non[dex_w]);
+ }
+ for (dex_w = 0; dex_w < pog_u->mem_u.len_w; ++dex_w) {
+ u3z(pog_u->mem_u.sot_u[dex_w].key);
+ }
+ for (dex_w = 0; dex_w < pog_u->cal_u.len_w; ++dex_w) {
+ u3j_site_lose(&(pog_u->cal_u.sit_u[dex_w]));
+ }
+ for (dex_w = 0; dex_w < pog_u->reg_u.len_w; ++dex_w) {
+ u3j_rite_lose(&(pog_u->reg_u.rit_u[dex_w]));
+ }
+ u3a_free(pog_u);
+}
+
+/* _cn_intlen(): find the number of characters num_w would take to print.
+** num_w: an int we want to later serialize to a string
+*/
+c3_w
+_cn_intlen(c3_w num_w)
+{
+ c3_w len_w=0;
+ while(num_w){
+ num_w/=10;
+ len_w++;
+ }
+ return len_w;
+}
+
+/* _cn_is_indexed(): return true if bop_w is an opcodes that uses pog_u->lit_u.non
+** bop_w: opcode (assumed 0-94)
+*/
+c3_b
+_cn_is_indexed(c3_w bop_w)
+{
+ switch (bop_w) {
+ case FIBK: case FISK:
+ case FIBL: case FISL:
+ case LIBK: case LISK:
+ case LIBL: case LISL:
+ case BUSH: case SUSH:
+ case SANB: case SANS:
+ case KITB: case KITS:
+ case MITB: case MITS:
+ case HILB: case HILS:
+ case HINB: case HINS:
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+/* _cn_pog_to_num(): read a bytecode from the steam and advance the index
+** par_w: c3_w: can be 0, 2, 4
+** pog_y: c3_y*: a bytecode stream
+** ip_w: c3_w: an index into pog
+*/
+#define _cn_pog_to_num(par_w, pog_y, ip_w) (\
+ par_w == 4 ? _n_rewo(pog_y, &ip_w): \
+ par_w == 2 ? _n_resh(pog_y, &ip_w): \
+ pog_y[ip_w++])
+
+/* _cn_etch_bytecode(): render a nock program as string of bytecodes
+** fol: a nock formula to compile and render
+** returns: a u3i_string noun of the rendered bytecode
+*/
+u3_noun
+_cn_etch_bytecode(u3_noun fol) {
+ u3n_prog* pog_u = _n_bite(fol);
+ c3_y* pog_y = pog_u->byc_u.ops_y;
+ c3_w len_w = pog_u->byc_u.len_w;
+ c3_w ip_w=0, num_w=0, bop_w=0, dex_w=0;
+ c3_w len_c = 2; // closing "}", null terminator
+ // set par_w (parameter flag) to an invalid value,
+ // so we can break imeadately if needed
+ c3_w par_w = 5;
+ // lets count the chars in this string
+ while ( ip_w < len_w ) {
+ par_w = _n_arg(pog_y[ip_w]);
+ bop_w = pog_y[ip_w++]; // move ip_w for reading a opcode name
+ dex_w = _cn_is_indexed(bop_w); // is this an indexed bytecode argument
+ len_c += 5; // a leading space, and opcode name
+ if (par_w > 0) { // if pair: "[bytecode arg]" else "bytecode"
+ len_c += 3; // "[", space between opcode & arg, "]"
+ if ( dex_w ) len_c += 2; // 'i:'
+ len_c += _cn_intlen( // length of the bytecode argument
+ _cn_pog_to_num(par_w, pog_y, ip_w)
+ );
+ }
+ }
+ // reset so we can loop again
+ ip_w=0, num_w=0, bop_w=0, dex_w=0, par_w=5;
+ // init our string, and give it a trailing null
+ c3_c str_c[len_c];
+ str_c[0] = 0;
+ // lets print this string
+ while ( ip_w < len_w ) {
+ par_w = _n_arg(pog_y[ip_w]);
+ bop_w = pog_y[ip_w++]; // move ip_w for reading a opcode name
+ dex_w = _cn_is_indexed(bop_w); // is this an indexed bytecode argument
+ strcat(str_c, " "); // leading space
+ if (par_w > 0) strcat(str_c, "["); // add "[" if the opcode pairs
+ strncat(str_c, opcode_names[bop_w], 4); // add the opcode name
+ if (par_w > 0) { // finish the pair
+ strcat(str_c, " "); // add the space between byt and arg
+ if ( dex_w ) strcat(str_c, "i:"); // indexed args are labeled as "index of arg"
+ num_w = _cn_pog_to_num(par_w, pog_y, ip_w); // the bytecode argument
+ if (num_w == 0) { //
+ strcat(str_c, "0"); // handle a literal zero
+ } //
+ else { //
+ c3_w x = 0; //
+ for (x = _cn_intlen(num_w); x > 0; x--) { //
+ strcat(str_c, "_"); // prefill the buffer
+ } //
+ c3_w f = strlen(str_c)-1; // get the index of the last prefill
+ while (num_w > 0) { // stringify number in LSB order
+ str_c[f--] = (num_w%10)+'0'; // .. stringify the tail of num into tail of buf
+ num_w /= 10; // .. turncate num by one digit
+ } //
+ } //
+ strcat(str_c, "]"); // add the closing brace
+ }
+ }
+ // replace the first leading space and append the last char to the string
+ str_c[0] = '{';
+ strcat(str_c, "}");
+ _cn_prog_free(pog_u);
+ return u3i_string(str_c);
+}
+
+
+/* _n_hilt_fore(): literal (atomic) dynamic hint, before formula evaluation.
+** hin: [hint-atom, formula]. TRANSFER
+** bus: subject. RETAIN
+** out: token for _n_hilt_hind(); convention:
+** [hint-atom] or [hint-atom data], ~ if unused.
+**
+** any hints herein must be whitelisted in _n_burn().
+*/
+static c3_o
+_n_hilt_fore(u3_noun hin, u3_noun bus, u3_noun* out)
+{
+ u3_noun tag, fol;
+ u3x_cell(hin, &tag, &fol);
+
+ switch ( tag ) {
+ case c3__cash: {
+ u3_atom har = u3i_word(u3h_count(u3R->cax.har_p));
+ u3h_discount(u3R->cax.har_p);
+ u3_atom per = u3i_word(u3h_count(u3R->cax.per_p));
+ u3h_discount(u3R->cax.per_p);
+ *out = u3i_cell(tag, u3i_cell(har, per));
+ } break;
+
+ case c3__bout: {
+ u3_atom now = u3i_chub(u3t_trace_time());
+ *out = u3i_cell(tag, now);
+ } break;
+
+ case c3__nara : {
+ u3t_slog_nara(0);
+ *out = u3_nul;
+ } break;
+
+ case c3__hela : {
+ u3t_slog_hela(0);
+ *out = u3_nul;
+ } break;
+
+ case c3__xray : {
+ u3t_slog(u3nc(0, _cn_etch_bytecode(fol)));
+ *out = u3_nul;
+ } break;
+
+ case c3__meme : {
+ u3t_slog(u3nc(0, u3t_etch_meme(0)));
+ *out = u3_nul;
+ } break;
+
+ default: {
+ *out = u3_nul;
+ } break;
+ }
+
+ u3z(hin);
+ return c3y;
+}
+
+/* _n_hilt_hind(): literal (atomic) dynamic hint, after formula evaluation.
+** tok: token from _n_hilt_fore(). TRANSFER
+** pro: product of formula evaluation. RETAIN
+*/
+static void
+_n_hilt_hind(u3_noun tok, u3_noun pro)
+{
+ u3_noun p_tok, q_tok, r_tok;
+ if ( (c3y == u3r_cell(tok, &p_tok, &q_tok)) && (c3__bout == p_tok) ) {
+ u3_atom delta = u3ka_sub(u3i_chub(u3t_trace_time()), u3k(q_tok));
+ c3_c str_c[64];
+ u3a_print_time(str_c, "took", u3r_chub(0, delta));
+ u3t_slog(u3nc(0, u3i_string(str_c)));
+ u3z(delta);
+ }
+ else if ( (c3y == u3r_trel(tok, &p_tok, &q_tok, &r_tok)) &&
+ (c3__cash == p_tok) ) {
+ c3_c str_c[4096];
+
+ u3_atom har = u3i_word(u3h_count(u3R->cax.har_p));
+ u3h_discount(u3R->cax.har_p);
+ u3_atom har_delta = u3ka_sub(har, u3k(q_tok));
+ u3a_print_memory_str(str_c, "ephemeral cache",
+ u3r_word(0, har_delta));
+ u3t_slog(u3nc(0, u3i_string(str_c)));
+
+ u3_atom per = u3i_word(u3h_count(u3R->cax.per_p));
+ u3h_discount(u3R->cax.per_p);
+ u3_atom per_delta = u3ka_sub(per, u3k(r_tok));
+ u3a_print_memory_str(str_c, "persistent cache",
+ u3r_word(0, per_delta));
+ u3t_slog(u3nc(0, u3i_string(str_c)));
+
+ u3z(har_delta);
+ u3z(per_delta);
+ }
+ else {
+ u3_assert( u3_nul == tok );
+ }
+
+ u3z(tok);
+}
+
+/* _n_hint_fore(): arbitrary dynamic hint, before formula evaluation
+** hin: [hint-atom, formula]. TRANSFER
+** bus: subject. RETAIN
+** clu: product of the hint-formula. TRANSFER
+** also, token for _n_hilt_hind(); convention:
+** [hint-atom] or [hint-atom data], ~ if unused.
+**
+** any hints herein must be whitelisted in _n_burn().
+*/
+static c3_o
+_n_hint_fore(u3_cell hin, u3_noun bus, u3_noun* clu)
+{
+ u3_noun tag, fol;
+ u3x_cell(hin, &tag, &fol);
+
+ switch ( tag ) {
+ case c3__bout: {
+ u3_atom now = u3i_chub(u3t_trace_time());
+ *clu = u3nt(u3k(tag), *clu, now);
+ } break;
+
+ case c3__spin: {
+ u3t_sstack_push(*clu);
+ *clu = c3__spin;
+ } break;
+
+ case c3__nara: {
+ u3_noun pri, tan;
+ if ( c3y == u3r_cell(*clu, &pri, &tan) ) {
+ c3_l pri_l = c3y == u3a_is_cat(pri) ? pri : 0;
+ u3t_slog_cap(pri_l, u3i_string("trace of"), u3k(tan));
+ u3t_slog_nara(pri_l);
+ }
+ u3z(*clu);
+ *clu = u3_nul;
+ } break;
+
+ case c3__hela: {
+ u3_noun pri, tan;
+ if ( c3y == u3r_cell(*clu, &pri, &tan) ) {
+ c3_l pri_l = c3y == u3a_is_cat(pri) ? pri : 0;
+ u3t_slog_cap(pri_l, u3i_string("trace of"), u3k(tan));
+ u3t_slog_hela(pri_l);
+ }
+ u3z(*clu);
+ *clu = u3_nul;
+ } break;
+
+ case c3__xray : {
+ u3_noun pri, tan;
+ if ( c3y == u3r_cell(*clu, &pri, &tan) ) {
+ c3_l pri_l = c3y == u3a_is_cat(pri) ? pri : 0;
+ u3t_slog_cap(pri_l, u3k(tan), _cn_etch_bytecode(fol));
+ }
+ u3z(*clu);
+ *clu = u3_nul;
+ } break;
+
+ case c3__meme : {
+ u3_noun pri, tan;
+ if ( c3y == u3r_cell(*clu, &pri, &tan) ) {
+ c3_l mod_l = c3y == u3a_is_cat(pri) ? pri : 0;
+ // replace with better str fmt
+ u3t_slog_cap(1, u3k(tan), u3t_etch_meme(mod_l));
+ }
+ u3z(*clu);
+ *clu = u3_nul;
+ } break;
+
+ default: {
+ u3z(*clu);
+ *clu = u3_nul;
+ } break;
+ }
+
+ u3z(hin);
+ return c3y;
+}
+
+/* _n_hint_hind(): arbitrary dynamic hint, after formula evaluation.
+** tok: token from _n_hint_fore(). TRANSFER
+** pro: product of formula evaluation. RETAIN
+*/
+static void
+_n_hint_hind(u3_noun tok, u3_noun pro)
+{
+ u3_noun p_tok, q_tok, r_tok;
+ if ( c3__spin == tok ) {
+ u3t_sstack_pop();
+ }
+ else if ( (c3y == u3r_trel(tok, &p_tok, &q_tok, &r_tok)) && (c3__bout == p_tok) ) {
+ // get the microseconds elapsed
+ u3_atom delta = u3ka_sub(u3i_chub(u3t_trace_time()), u3k(r_tok));
+
+ // unpack q_tok to get the priority integer and the tank
+ // p_q_tok is the priority, q_q_tok is the tank we will work with
+ u3_noun p_q_tok, q_q_tok;
+ u3_assert(c3y == u3r_cell(q_tok, &p_q_tok, &q_q_tok));
+
+ // format the timing report
+ c3_c str_c[64];
+ u3a_print_time(str_c, "took", u3r_chub(0, delta));
+
+ // join the timing report with the original tank from q_q_tok like so:
+ // "q_q_tok: report"
+ // prepend the priority to form a cell of the same shape q_tok
+ // send this to ut3_slog so that it can be logged out
+ c3_l pri_l = c3y == u3a_is_cat(p_q_tok) ? p_q_tok : 0;
+ u3t_slog_cap(pri_l, u3k(q_q_tok), u3i_string(str_c));
+ u3z(delta);
+ }
+ else {
+ u3_assert( u3_nul == tok );
+ }
+
+ u3z(tok);
+}
+
+/* _n_kick(): stop tracing noc and kick a u3j_site.
+ */
+static u3_weak
+_n_kick(u3_noun cor, u3j_site* sit_u)
+{
+ u3_weak pro;
+ u3t_off(noc_o);
+ pro = u3j_site_kick(cor, sit_u);
+ u3t_on(noc_o);
+ return pro;
+}
+
+/* _n_kale(): bail(exit) if not cell
+ */
+static inline u3_noun
+_n_kale(u3_noun a)
+{
+ if ( c3n == u3du(a) ) {
+ u3m_bail(c3__exit);
+ }
+ return a;
+}
+
+typedef struct __attribute__((__packed__)) {
+ u3n_prog* pog_u;
+ c3_w ip_w;
+} burnframe;
+
+/* _n_burn(): pog: program
+ * bus: subject (TRANSFER)
+ * mov: -1 north, 1 south
+ * off: 0 north, -1 south
+ */
+static u3_noun
+_n_burn(u3n_prog* pog_u, u3_noun bus, c3_ys mov, c3_ys off)
+{
+
+ // Opcode jump table. Define X to select the opcode computed goto from
+ // OPCODES.
+# define X(opcode, name, indirect_jump) indirect_jump
+ static void* lab[] = { OPCODES };
+# undef X
+
+ u3j_site* sit_u;
+ u3j_rite* rit_u;
+ u3n_memo* mem_u;
+ c3_y *pog = pog_u->byc_u.ops_y;
+ c3_w sip_w, ip_w = 0;
+ u3_noun* top;
+ u3_noun x, o;
+ u3p(void) empty;
+ burnframe* fam;
+
+ empty = u3R->cap_p;
+ _n_push(mov, off, bus);
+
+#ifdef U3_CPU_DEBUG
+ u3R->pro.nox_d += 1;
+#endif
+#ifdef VERBOSE_BYTECODE
+ #define BURN() fprintf(stderr, "%s ", opcode_names[pog[ip_w]]); goto *lab[pog[ip_w++]]
+#else
+ #define BURN() goto *lab[pog[ip_w++]]
+#endif
+ BURN();
+ {
+ do_halt: // [product ...burnframes...]
+ x = _n_pep(mov, off);
+#ifdef VERBOSE_BYTECODE
+ fprintf(stderr, "return\r\n");
+#endif
+ if ( empty == u3R->cap_p ) {
+ return x;
+ }
+ else {
+ fam = u3to(burnframe, u3R->cap_p) + off;
+ pog_u = fam->pog_u;
+ pog = pog_u->byc_u.ops_y;
+ ip_w = fam->ip_w;
+
+ u3R->cap_p = u3of(burnframe, fam - (mov+off));
+ _n_push(mov, off, x);
+#ifdef VERBOSE_BYTECODE
+ _n_print_byc(pog, ip_w);
+#endif
+ BURN();
+ }
+
+ do_bail:
+ u3m_bail(c3__exit);
+ return u3_none;
+
+ do_copy:
+ top = _n_peek(off);
+ _n_push(mov, off, u3k(*top));
+ BURN();
+
+ do_swap:
+ _n_swap(mov, off);
+ BURN();
+
+ do_toss:
+ _n_toss(mov, off);
+ BURN();
+
+ do_auto: // [tel bus hed]
+ x = _n_pep(mov, off); // [bus hed]
+ top = _n_swap(mov, off); // [hed bus]
+ *top = u3nc(*top, x); // [pro bus]
+ BURN();
+
+ do_ault: // [tel hed]
+ x = _n_pep(mov, off); // [hed]
+ top = _n_peek(off);
+ *top = u3nc(*top, x); // [pro]
+ BURN();
+
+ do_snoc: // [hed tel]
+ x = _n_pep(mov, off);
+ top = _n_peek(off);
+ _n_push(mov, off, u3nc(x, u3k(*top)));
+ BURN();
+
+ do_snol:
+ x = _n_pep(mov, off);
+ top = _n_peek(off);
+ *top = u3nc(x, *top);
+ BURN();
+
+ do_head:
+ top = _n_peek(off);
+ _n_push(mov, off, u3k(u3h(_n_kale(*top))));
+ BURN();
+
+ do_held:
+ top = _n_peek(off);
+ o = _n_kale(*top);
+ *top = u3k(u3h(o));
+ u3z(o);
+ BURN();
+
+ do_tail:
+ top = _n_peek(off);
+ _n_push(mov, off, u3k(u3t(_n_kale(*top))));
+ BURN();
+
+ do_tall:
+ top = _n_peek(off);
+ o = _n_kale(*top);
+ *top = u3k(u3t(o));
+ u3z(o);
+ BURN();
+
+ do_fisk:
+ x = pog_u->lit_u.non[_n_resh(pog, &ip_w)];
+ goto frag_in;
+
+ do_fibk:
+ x = pog_u->lit_u.non[pog[ip_w++]];
+ goto frag_in;
+
+ do_fask:
+ x = _n_resh(pog, &ip_w);
+ goto frag_in;
+
+ do_fabk:
+ x = pog[ip_w++];
+ frag_in:
+ top = _n_peek(off);
+ _n_push(mov, off, u3k(u3x_at(x, *top)));
+ BURN();
+
+ do_fisl:
+ x = pog_u->lit_u.non[_n_resh(pog, &ip_w)];
+ goto flag_in;
+
+ do_fibl:
+ x = pog_u->lit_u.non[pog[ip_w++]];
+ goto flag_in;
+
+ do_fasl:
+ x = _n_resh(pog, &ip_w);
+ goto flag_in;
+
+ do_fabl:
+ x = pog[ip_w++];
+ flag_in:
+ top = _n_peek(off);
+ o = *top;
+ *top = u3k(u3x_at(x, o));
+ u3z(o);
+ BURN();
+
+ do_lit0:
+ _n_push(mov, off, 0);
+ BURN();
+
+ do_lit1:
+ _n_push(mov, off, 1);
+ BURN();
+
+ do_litb:
+ _n_push(mov, off, pog[ip_w++]);
+ BURN();
+
+ do_lits:
+ _n_push(mov, off, _n_resh(pog, &ip_w));
+ BURN();
+
+ do_libk:
+ _n_push(mov, off, u3k(pog_u->lit_u.non[pog[ip_w++]]));
+ BURN();
+
+ do_lisk:
+ _n_push(mov, off, u3k(pog_u->lit_u.non[_n_resh(pog, &ip_w)]));
+ BURN();
+
+ do_lil1:
+ x = 1;
+ goto lil_in;
+
+ do_lilb:
+ x = pog[ip_w++];
+ goto lil_in;
+
+ do_lils:
+ x = _n_resh(pog, &ip_w);
+ goto lil_in;
+
+ do_libl:
+ x = u3k(pog_u->lit_u.non[pog[ip_w++]]);
+ goto lil_in;
+
+ do_lisl:
+ x = u3k(pog_u->lit_u.non[_n_resh(pog, &ip_w)]);
+ goto lil_in;
+
+ do_lil0:
+ x = 0;
+ lil_in:
+ top = _n_peek(off);
+ u3z(*top);
+ *top = x;
+ BURN();
+
+ do_noct: // [fol bus]
+ o = _n_pep(mov, off); // [bus]
+ goto nock_out;
+
+ do_nolk: // [fol bus]
+ o = _n_pep(mov, off); // [bus]
+ goto nock_in;
+
+ do_nock: // [fol old bus]
+ o = _n_pep(mov, off); // [old bus]
+ _n_swap(mov, off); // [bus old]
+ nock_in:
+ x = _n_pep(mov, off);
+ fam = u3to(burnframe, u3R->cap_p) + off + mov;
+ u3R->cap_p = u3of(burnframe, fam - off);
+ fam->ip_w = ip_w;
+ fam->pog_u = pog_u;
+ _n_push(mov, off, x);
+ nock_out:
+ pog_u = _n_find(u3_nul, o);
+ pog = pog_u->byc_u.ops_y;
+ ip_w = 0;
+#ifdef U3_CPU_DEBUG
+ u3R->pro.nox_d += 1;
+#endif
+#ifdef VERBOSE_BYTECODE
+ fprintf(stderr, "\r\nnock jump: %u\r\n", o);
+ _n_print_byc(pog, ip_w);
+#endif
+ u3z(o);
+ BURN();
+
+ do_deep:
+ top = _n_peek(off);
+ o = *top;
+ *top = u3du(o);
+ u3z(o);
+ BURN();
+
+ do_bump:
+ top = _n_peek(off);
+ *top = u3i_vint(*top);
+ BURN();
+
+ do_sam0:
+ top = _n_peek(off);
+ if ( *top == 0 ) {
+ *top = c3y;
+ }
+ else {
+ u3z(*top);
+ *top = c3n;
+ }
+ BURN();
+
+ do_sam1:
+ top = _n_peek(off);
+ if ( *top == 1 ) {
+ *top = c3y;
+ }
+ else {
+ u3z(*top);
+ *top = c3n;
+ }
+ BURN();
+
+ do_samb:
+ top = _n_peek(off);
+ if ( *top == pog[ip_w++] ) {
+ *top = c3y;
+ }
+ else {
+ u3z(*top);
+ *top = c3n;
+ }
+ BURN();
+
+ do_sams:
+ top = _n_peek(off);
+ if ( *top == _n_resh(pog, &ip_w) ) {
+ *top = c3y;
+ }
+ else {
+ u3z(*top);
+ *top = c3n;
+ }
+ BURN();
+
+ do_sans:
+ x = pog_u->lit_u.non[_n_resh(pog, &ip_w)];
+ goto samn_in;
+ do_sanb:
+ x = pog_u->lit_u.non[pog[ip_w++]];
+ samn_in:
+ top = _n_peek(off);
+ o = *top;
+ *top = u3r_sing(o, x);
+ u3z(o);
+ BURN();
+
+ do_same:
+ x = _n_pep(mov, off);
+ _n_swap(mov, off);
+ goto same_in;
+
+ do_salm:
+ x = _n_pep(mov, off);
+ goto same_in;
+
+ same_in:
+ top = _n_peek(off);
+ o = *top;
+ *top = u3r_sing(x, o);
+ u3z(o);
+ u3z(x);
+ BURN();
+
+ do_samc:
+ top = _n_peek(off);
+ o = *top;
+ *top = u3r_sing(u3h(o), u3t(o));
+ u3z(o);
+ BURN();
+
+ do_sbip:
+ sip_w = pog[ip_w++];
+ ip_w += sip_w;
+ BURN();
+
+ do_sips:
+ sip_w = _n_resh(pog, &ip_w);
+ ip_w += sip_w;
+ BURN();
+
+ do_swip:
+ sip_w = _n_rewo(pog, &ip_w);
+ ip_w += sip_w;
+ BURN();
+
+ do_swin:
+ sip_w = _n_rewo(pog, &ip_w);
+ goto skin_in;
+
+ do_sins:
+ sip_w = _n_resh(pog, &ip_w);
+ goto skin_in;
+
+ do_sbin:
+ sip_w = pog[ip_w++];
+ skin_in:
+ x = _n_pep(mov, off);
+ if ( c3n == x ) {
+ ip_w += sip_w;
+ }
+ else if ( c3y != x ) {
+ u3m_bail(c3__exit);
+ return u3_none;
+ }
+ BURN();
+
+ do_kics:
+ x = _n_resh(pog, &ip_w);
+ goto kick_in;
+
+ do_kicb:
+ x = pog[ip_w++];
+ kick_in:
+ sit_u = &(pog_u->cal_u.sit_u[x]);
+ top = _n_peek(off);
+ o = *top;
+ *top = _n_kick(o, sit_u);
+ if ( u3_none == *top ) {
+ _n_pop(mov);
+
+ fam = u3to(burnframe, u3R->cap_p) + off + mov;
+ u3R->cap_p = u3of(burnframe, fam - off);
+ fam->ip_w = ip_w;
+ fam->pog_u = pog_u;
+
+ pog_u = u3to(u3n_prog, sit_u->pog_p);
+ pog = pog_u->byc_u.ops_y;
+ ip_w = 0;
+#ifdef U3_CPU_DEBUG
+ u3R->pro.nox_d += 1;
+#endif
+#ifdef VERBOSE_BYTECODE
+ fprintf(stderr, "\r\nhead kick jump: %u, sp: %p\r\n", u3r_at(sit_u->axe, cor), top);
+ _n_print_byc(pog, ip_w);
+#endif
+ _n_push(mov, off, o);
+ }
+#ifdef VERBOSE_BYTECODE
+ else {
+ fprintf(stderr, "head jet\r\n");
+ }
+#endif
+ BURN();
+
+ do_tics:
+ x = _n_resh(pog, &ip_w);
+ goto tick_in;
+
+ do_ticb:
+ x = pog[ip_w++];
+ tick_in:
+ sit_u = &(pog_u->cal_u.sit_u[x]);
+ top = _n_peek(off);
+ o = *top;
+ *top = _n_kick(o, sit_u);
+ if ( u3_none == *top ) {
+ *top = o;
+ pog_u = u3to(u3n_prog, sit_u->pog_p);
+ pog = pog_u->byc_u.ops_y;
+ ip_w = 0;
+#ifdef U3_CPU_DEBUG
+ u3R->pro.nox_d += 1;
+#endif
+#ifdef VERBOSE_BYTECODE
+ fprintf(stderr, "\r\ntail kick jump: %u, sp: %p\r\n", u3x_at(sit_u->axe, o);, top);
+ _n_print_byc(pog, ip_w);
+#endif
+ }
+#ifdef VERBOSE_BYTECODE
+ else {
+ fprintf(stderr, "tail jet\r\n");
+ }
+#endif
+ BURN();
+
+ do_wils: // [gof ref]
+ o = _n_pep(mov,off); // [ref]
+ top = _n_peek(off);
+ goto wish_in;
+
+ do_wish: // [gof bus ref]
+ o = _n_pep(mov,off); // [bus ref]
+ top = _n_swap(mov, off); // [ref bus]
+ wish_in:
+ u3t_off(noc_o);
+ x = u3m_soft_esc(u3k(*top), u3k(o));
+ u3t_on(noc_o);
+
+ if ( c3n == u3du(x) ) {
+ u3m_bail(u3nc(1, o));
+ return u3_none;
+ }
+ else if ( c3n == u3du(u3t(x)) ) {
+ u3t_push(u3nt(c3__hunk, *top, o));
+ u3m_bail(c3__exit);
+ return u3_none;
+ }
+ else {
+ u3z(o);
+ u3z(*top);
+ *top = u3k(u3t(u3t(x)));
+ u3z(x);
+ BURN();
+ }
+
+ do_sush:
+ x = _n_resh(pog, &ip_w);
+ goto cush_in;
+
+ do_bush:
+ x = pog[ip_w++];
+ cush_in:
+ x = u3k(pog_u->lit_u.non[x]);
+ o = _n_pep(mov, off);
+ u3t_push(u3nc(x, o));
+ BURN();
+
+ do_drop:
+ u3t_drop();
+ BURN();
+
+ do_heck:
+ x = _n_pep(mov, off);
+ if ( c3y == u3ud(x) ) {
+ u3t_off(noc_o);
+ u3t_heck(x);
+ u3t_on(noc_o);
+ }
+ else {
+ u3z(x);
+ }
+ BURN();
+
+ do_slog:
+ x = _n_pep(mov, off);
+ if ( !(u3C.wag_w & u3o_quiet) ) {
+ u3t_off(noc_o);
+ u3t_slog(x);
+ u3t_on(noc_o);
+ }
+ else {
+ u3z(x);
+ }
+ BURN();
+
+
+ do_sast:
+ x = _n_resh(pog, &ip_w);
+ goto fast_in;
+
+ do_bast:
+ x = pog[ip_w++];
+ goto fast_in;
+
+ do_salt:
+ x = _n_resh(pog, &ip_w);
+ goto falt_in;
+ do_balt:
+ x = pog[ip_w++];
+ falt_in: // [pro clu]
+ o = _n_pep(mov, off); // [clu]
+ top = _n_peek(off);
+ goto fast_out;
+
+ fast_in: // [pro bus clu]
+ o = _n_pep(mov, off); // [bus clu]
+ top = _n_swap(mov, off); // [clu bus]
+ fast_out:
+ rit_u = &(pog_u->reg_u.rit_u[x]);
+ u3t_off(noc_o);
+ u3j_rite_mine(rit_u, *top, u3k(o));
+ u3t_on(noc_o);
+ *top = o;
+ BURN();
+
+ do_skis:
+ x = _n_resh(pog, &ip_w);
+ goto skim_in;
+
+ do_skib:
+ x = pog[ip_w++];
+ skim_in:
+ mem_u = &(pog_u->mem_u.sot_u[x]);
+ top = _n_peek(off);
+ x = u3k(*top);
+ goto skim_out;
+
+ do_slis:
+ x = _n_resh(pog, &ip_w);
+ goto slim_in;
+
+ do_slib:
+ x = pog[ip_w++];
+ slim_in:
+ mem_u = &(pog_u->mem_u.sot_u[x]);
+ x = _n_pep(mov, off);
+ skim_out:
+ o = u3k(mem_u->key);
+ x = u3nc(x, o);
+ o = u3z_find_m(mem_u->cid, 144 + c3__nock, x);
+ if ( u3_none == o ) {
+ _n_push(mov, off, u3nc(mem_u->cid, x));
+ _n_push(mov, off, u3k(u3h(x)));
+ }
+ else {
+ ip_w += mem_u->sip_l;
+ _n_push(mov, off, o);
+ u3z(x);
+ }
+ BURN();
+
+ do_save:
+ x = _n_pep(mov, off); // product
+ top = _n_peek(off);
+ o = *top;
+ if ( ( u3z_memo_toss == u3h(o) )
+ ? ( &(u3H->rod_u) != u3R )
+ : ( 0 == u3R->ski.gul ) ) { // prevents userspace from persistence
+ u3z_save_m(u3h(o), 144 + c3__nock, u3t(o), x);
+ }
+ // XX can we still print?
+ // else if ( u3z_memo_keep == u3h(o) ) {
+ // fprintf(stderr, "\r\nnock: userspace can't save to persistent cache\r\n");
+ // }
+ *top = x;
+ u3z(o);
+ BURN();
+
+ do_hilb:
+ x = pog[ip_w++];
+ goto hilt_fore_in;
+
+ do_hils:
+ x = _n_resh(pog, &ip_w);
+ hilt_fore_in:
+ x = u3k(pog_u->lit_u.non[x]);
+ top = _n_peek(off); // bus
+ x = _n_hilt_fore(x, *top, &o);
+ _n_push(mov, off, o);
+ _n_swap(mov, off); // bus
+ _n_push(mov, off, x); // shortcircuit if c3n
+ BURN();
+
+ do_hinb:
+ x = pog[ip_w++];
+ goto hint_fore_in;
+
+ do_hins:
+ x = _n_resh(pog, &ip_w);
+ hint_fore_in: // [clu bus]
+ x = u3k(pog_u->lit_u.non[x]);
+ o = _n_pep(mov, off); // [bus]
+ top = _n_peek(off);
+ x = _n_hint_fore(x, *top, &o);
+ _n_push(mov, off, o); // [tok bus]
+ _n_swap(mov, off); // [bus tok]
+ _n_push(mov, off, x); // [kip bus tok]
+ BURN();
+
+ do_hilk: // [pro bus tok]
+ x = _n_pep(mov, off); // [bus tok]
+ _n_swap(mov, off); // [tok bus]
+ o = _n_pep(mov, off); // [bus]
+ _n_push(mov, off, x); // [pro bus]
+ _n_hilt_hind(o, x);
+ BURN();
+
+ do_hill: // [pro tok]
+ top = _n_swap(mov, off); // [tok pro]
+ o = _n_pep(mov, off); // [pro]
+ top = _n_peek(off);
+ _n_hilt_hind(o, *top);
+ BURN();
+
+ do_hink: // [pro bus tok]
+ x = _n_pep(mov, off); // [bus tok]
+ _n_swap(mov, off); // [tok bus]
+ o = _n_pep(mov, off); // [bus]
+ _n_push(mov, off, x); // [pro bus]
+ _n_hint_hind(o, x);
+ BURN();
+
+ do_hinl: // [pro tok]
+ top = _n_swap(mov, off); // [tok pro]
+ o = _n_pep(mov, off); // [pro]
+ top = _n_peek(off);
+ _n_hint_hind(o, *top);
+ BURN();
+
+ do_kuth:
+ x = _n_pep(mov, off);
+ top = _n_swap(mov, off);
+ goto muth_in;
+ do_muth:
+ x = _n_pep(mov, off);
+ top = _n_peek(off);
+ muth_in:
+ o = *top;
+ *top = u3nc(x, u3k(u3t(o)));
+ u3z(o);
+ BURN();
+
+ do_kutt:
+ x = _n_pep(mov, off);
+ top = _n_swap(mov, off);
+ goto mutt_in;
+ do_mutt:
+ x = _n_pep(mov, off);
+ top = _n_peek(off);
+ mutt_in:
+ o = *top;
+ *top = u3nc(u3k(u3h(o)), x);
+ u3z(o);
+ BURN();
+
+ do_kusm:
+ x = _n_pep(mov, off);
+ top = _n_swap(mov, off);
+ goto musm_in;
+ do_musm:
+ x = _n_pep(mov, off);
+ top = _n_peek(off);
+ musm_in:
+ o = *top;
+ *top = u3nt(u3k(u3h(o)), x, u3k(u3t(u3t(o))));
+ u3z(o);
+ BURN();
+
+ do_kitb:
+ x = pog_u->lit_u.non[pog[ip_w++]];
+ goto kut_in;
+
+ do_kits:
+ x = pog_u->lit_u.non[_n_resh(pog, &ip_w)];
+ goto kut_in;
+
+ do_kuts:
+ x = _n_resh(pog, &ip_w);
+ goto kut_in;
+
+ do_kutb:
+ x = pog[ip_w++];
+ kut_in:
+ o = _n_pep(mov, off);
+ top = _n_swap(mov, off);
+ goto edit_in;
+
+ do_mitb:
+ x = pog_u->lit_u.non[pog[ip_w++]];
+ goto mut_in;
+
+ do_mits:
+ x = pog_u->lit_u.non[_n_resh(pog, &ip_w)];
+ goto mut_in;
+
+ do_muts:
+ x = _n_resh(pog, &ip_w);
+ goto mut_in;
+
+ do_mutb:
+ x = pog[ip_w++];
+ mut_in:
+ o = _n_pep(mov, off);
+ top = _n_peek(off);
+ edit_in:
+ *top = u3i_edit(*top, x, o);
+ BURN();
+ }
+}
+
+/* _n_burn_out(): execute u3n_prog with bus as subject.
+ */
+static u3_noun
+_n_burn_out(u3_noun bus, u3n_prog* pog_u)
+{
+ c3_ys mov, off;
+ if ( c3y == u3a_is_north(u3R) ) {
+ mov = -1;
+ off = 0;
+ }
+ else {
+ mov = 1;
+ off = -1;
+ }
+ return _n_burn(pog_u, bus, mov, off);
+}
+
+/* u3n_burn(): execute u3n_prog with bus as subject.
+ */
+u3_noun
+u3n_burn(u3p(u3n_prog) pog_p, u3_noun bus)
+{
+ u3_noun pro;
+ u3t_on(noc_o);
+ pro = _n_burn_out(bus, u3to(u3n_prog, pog_p));
+ u3t_off(noc_o);
+ return pro;
+}
+
+/* _n_burn_on(): produce .*(bus fol) with bytecode interpreter
+ */
+static u3_noun
+_n_burn_on(u3_noun bus, u3_noun fol)
+{
+ u3n_prog* pog_u = _n_find(u3_nul, fol);
+
+ u3z(fol);
+ return _n_burn_out(bus, pog_u);
+}
+
+/* u3n_nock_on(): produce .*(bus fol). Do not virtualize.
+*/
+u3_noun
+u3n_nock_on(u3_noun bus, u3_noun fol)
+{
+ u3_noun pro;
+
+ u3t_on(noc_o);
+#if 0
+ pro = _n_nock_on(bus, fol);
+#else
+ pro = _n_burn_on(bus, fol);
+#endif
+ u3t_off(noc_o);
+
+ return pro;
+}
+
+/* _cn_take_prog_dat(): take references from junior u3n_prog.
+*/
+static void
+_cn_take_prog_dat(u3n_prog* dst_u, u3n_prog* src_u)
+{
+ c3_w i_w;
+
+ for ( i_w = 0; i_w < src_u->lit_u.len_w; ++i_w ) {
+ dst_u->lit_u.non[i_w] = u3a_take(src_u->lit_u.non[i_w]);
+ }
+
+ for ( i_w = 0; i_w < src_u->mem_u.len_w; ++i_w ) {
+ u3n_memo* emo_u = &(src_u->mem_u.sot_u[i_w]);
+ u3n_memo* ome_u = &(dst_u->mem_u.sot_u[i_w]);
+ ome_u->sip_l = emo_u->sip_l;
+ ome_u->key = u3a_take(emo_u->key);
+ ome_u->cid = emo_u->cid;
+ }
+
+ for ( i_w = 0; i_w < src_u->cal_u.len_w; ++i_w ) {
+ u3j_site_take(&(dst_u->cal_u.sit_u[i_w]),
+ &(src_u->cal_u.sit_u[i_w]));
+ }
+
+ for ( i_w = 0; i_w < src_u->reg_u.len_w; ++i_w ) {
+ u3j_rite_take(&(dst_u->reg_u.rit_u[i_w]),
+ &(src_u->reg_u.rit_u[i_w]));
+ }
+}
+
+/* _cn_take_prog_cb(): u3h_take_with cb for taking junior u3n_prog's.
+*/
+static u3p(u3n_prog)
+_cn_take_prog_cb(c3_w pog_w)
+{
+ u3n_prog* pog_u = _cn_to_prog(pog_w);
+ u3n_prog* gop_u;
+
+ if ( c3y == pog_u->byc_u.own_o ) {
+ c3_w pad_w = (8 - pog_u->byc_u.len_w % 8) % 8;
+ gop_u = _n_prog_new(pog_u->byc_u.len_w,
+ pog_u->cal_u.len_w,
+ pog_u->reg_u.len_w,
+ pog_u->lit_u.len_w,
+ pog_u->mem_u.len_w);
+ memcpy(gop_u->byc_u.ops_y, pog_u->byc_u.ops_y, pog_u->byc_u.len_w + pad_w);
+ }
+ else {
+ gop_u = _n_prog_old(pog_u);
+ }
+
+ _cn_take_prog_dat(gop_u, pog_u);
+ // _n_prog_take_dat(gop_u, pog_u, c3n);
+
+ return _cn_of_prog(gop_u);
+}
+
+/* u3n_take(): copy junior bytecode state.
+*/
+u3p(u3h_root)
+u3n_take(u3p(u3h_root) har_p)
+{
+ return u3h_take_with(har_p, _cn_take_prog_cb);
+}
+
+/* _cn_merge_prog_dat(): copy references from src_u u3n_prog to dst_u.
+*/
+static void
+_cn_merge_prog_dat(u3n_prog* dst_u, u3n_prog* src_u)
+{
+ c3_w i_w;
+
+ for ( i_w = 0; i_w < src_u->lit_u.len_w; ++i_w ) {
+ u3z(dst_u->lit_u.non[i_w]);
+ dst_u->lit_u.non[i_w] = src_u->lit_u.non[i_w];
+ }
+
+ for ( i_w = 0; i_w < src_u->mem_u.len_w; ++i_w ) {
+ u3n_memo* emo_u = &(dst_u->mem_u.sot_u[i_w]);
+ u3n_memo* ome_u = &(src_u->mem_u.sot_u[i_w]);
+ u3z(emo_u->key);
+ emo_u->sip_l = ome_u->sip_l;
+ emo_u->key = ome_u->key;
+ emo_u->cid = ome_u->cid;
+ }
+
+ for ( i_w = 0; i_w < src_u->cal_u.len_w; ++i_w ) {
+ u3j_site_merge(&(dst_u->cal_u.sit_u[i_w]),
+ &(src_u->cal_u.sit_u[i_w]));
+ }
+
+ for ( i_w = 0; i_w < src_u->reg_u.len_w; ++i_w ) {
+ u3j_rite_merge(&(dst_u->reg_u.rit_u[i_w]),
+ &(src_u->reg_u.rit_u[i_w]));
+ }
+}
+
+/* _cn_merge_prog_cb(): u3h_walk_with cb for integrating taken u3n_prog's.
+*/
+static void
+_cn_merge_prog_cb(u3_noun kev, void* wit)
+{
+ u3p(u3h_root) har_p = *(u3p(u3h_root)*)wit;
+ u3n_prog* pog_u;
+ u3_weak got;
+ u3_noun key;
+ c3_w pog_w;
+ u3x_cell(kev, &key, &pog_w);
+
+ pog_u = _cn_to_prog(pog_w);
+ got = u3h_git(har_p, key);
+
+ if ( u3_none != got ) {
+ u3n_prog* sep_u = _cn_to_prog(got);
+ _cn_merge_prog_dat(sep_u, pog_u);
+ u3a_free(pog_u);
+ pog_u = sep_u;
+ }
+
+ u3h_put(har_p, key, _cn_of_prog(pog_u));
+}
+
+/* u3n_reap(): promote bytecode state.
+*/
+void
+u3n_reap(u3p(u3h_root) har_p)
+{
+ u3h_walk_with(har_p, _cn_merge_prog_cb, &u3R->byc.har_p);
+ // NB *not* u3n_free, _cn_merge_prog_cb() transfers u3n_prog's
+ u3h_free(har_p);
+}
+
+/* _n_ream(): ream program call sites
+*/
+void
+_n_ream(u3_noun kev)
+{
+ u3n_prog* pog_u = _cn_to_prog(u3t(kev));
+
+ c3_w pad_w = (8 - pog_u->byc_u.len_w % 8) % 8;
+ c3_w pod_w = pog_u->lit_u.len_w % 2;
+ c3_w ped_w = pog_u->mem_u.len_w % 2;
+ // fix up pointers for loom portability
+ pog_u->byc_u.ops_y = (c3_y*) _n_prog_dat(pog_u);
+ pog_u->lit_u.non = (u3_noun*) (pog_u->byc_u.ops_y + pog_u->byc_u.len_w + pad_w);
+ pog_u->mem_u.sot_u = (u3n_memo*) (pog_u->lit_u.non + pog_u->lit_u.len_w + pod_w);
+ pog_u->cal_u.sit_u = (u3j_site*) (pog_u->mem_u.sot_u + pog_u->mem_u.len_w + ped_w);
+ pog_u->reg_u.rit_u = (u3j_rite*) (pog_u->cal_u.sit_u + pog_u->cal_u.len_w);
+
+ for ( c3_w i_w = 0; i_w < pog_u->cal_u.len_w; ++i_w ) {
+ u3j_site_ream(&(pog_u->cal_u.sit_u[i_w]));
+ }
+}
+
+/* u3n_ream(): refresh after restoring from checkpoint.
+*/
+void
+u3n_ream()
+{
+ u3_assert(u3R == &(u3H->rod_u));
+ u3h_walk(u3R->byc.har_p, _n_ream);
+}
+
+/* _n_prog_mark(): mark program for gc.
+*/
+static c3_w
+_n_prog_mark(u3n_prog* pog_u)
+{
+ c3_w i_w, tot_w = u3a_mark_mptr(pog_u);
+
+ for ( i_w = 0; i_w < pog_u->lit_u.len_w; ++i_w ) {
+ tot_w += u3a_mark_noun(pog_u->lit_u.non[i_w]);
+ }
+
+ for ( i_w = 0; i_w < pog_u->mem_u.len_w; ++i_w ) {
+ tot_w += u3a_mark_noun(pog_u->mem_u.sot_u[i_w].key);
+ }
+
+ for ( i_w = 0; i_w < pog_u->cal_u.len_w; ++i_w ) {
+ tot_w += u3j_site_mark(&(pog_u->cal_u.sit_u[i_w]));
+ }
+
+ for ( i_w = 0; i_w < pog_u->reg_u.len_w; ++i_w ) {
+ tot_w += u3j_rite_mark(&(pog_u->reg_u.rit_u[i_w]));
+ }
+
+ return tot_w;
+}
+
+/* _n_bam(): u3h_walk_with helper for u3n_mark
+ */
+static void
+_n_bam(u3_noun kev, void* dat)
+{
+ u3n_prog* pog = _cn_to_prog(u3t(kev));
+ c3_w* bam_w = dat;
+
+ *bam_w += _n_prog_mark(pog);
+}
+
+/* u3n_mark(): mark the bytecode cache for gc.
+ */
+u3m_quac*
+u3n_mark()
+{
+ u3m_quac** qua_u = c3_malloc(sizeof(*qua_u) * 3);
+
+ qua_u[0] = c3_calloc(sizeof(*qua_u[0]));
+ qua_u[0]->nam_c = strdup("bytecode programs");
+
+ u3p(u3h_root) har_p = u3R->byc.har_p;
+ u3h_walk_with(har_p, _n_bam, &qua_u[0]->siz_w);
+ qua_u[0]->siz_w = qua_u[0]->siz_w * 4;
+
+ qua_u[1] = c3_calloc(sizeof(*qua_u[1]));
+ qua_u[1]->nam_c = strdup("bytecode cache");
+ qua_u[1]->siz_w = u3h_mark(har_p) * 4;
+
+ qua_u[2] = NULL;
+
+ u3m_quac* tot_u = c3_malloc(sizeof(*tot_u));
+ tot_u->nam_c = strdup("total nock stuff");
+ tot_u->siz_w = qua_u[0]->siz_w + qua_u[1]->siz_w;
+ tot_u->qua_u = qua_u;
+
+ return tot_u;
+}
+
+/* u3n_reclaim(): clear ad-hoc persistent caches to reclaim memory.
+*/
+void
+u3n_reclaim(void)
+{
+ // clear the bytecode cache
+ //
+ // We can't just u3h_free() -- the value is a post to a u3n_prog.
+ // Note that the hank cache *must* also be freed (in u3j_reclaim())
+ //
+ u3n_free();
+ u3R->byc.har_p = u3h_new();
+}
+
+/* u3n_rewrite_compact(): rewrite the bytecode cache for compaction.
+ *
+ * NB: u3R->byc.har_p *must* be cleared (currently via u3n_reclaim above),
+ * since it contains things that look like nouns but aren't.
+ * Specifically, it contains "cells" where the tail is a
+ * pointer to a u3a_malloc'ed block that contains loom pointers.
+ *
+ * You should be able to walk this with u3h_walk and rewrite the
+ * pointers, but you need to be careful to handle that u3a_malloc
+ * pointers can't be turned into a box by stepping back two words. You
+ * must step back one word to get the padding, step then step back that
+ * many more words (plus one?).
+ */
+void
+u3n_rewrite_compact()
+{
+ u3h_relocate(&(u3R->byc.har_p));
+}
+
+
+/* _n_feb(): u3h_walk helper for u3n_free
+ */
+static void
+_n_feb(u3_noun kev)
+{
+ _cn_prog_free(_cn_to_prog(u3t(kev)));
+}
+
+/* u3n_free(): free bytecode cache
+ */
+void
+u3n_free()
+{
+ u3p(u3h_root) har_p = u3R->byc.har_p;
+ u3h_walk(har_p, _n_feb);
+ u3h_free(har_p);
+}
+
+/* u3n_kick_on(): fire `gat` without changing the sample.
+*/
+u3_noun
+u3n_kick_on(u3_noun gat)
+{
+ return u3j_kink(gat, 2);
+}
+
+c3_w exc_w;
+
+/* u3n_slam_on(): produce (gat sam).
+*/
+u3_noun
+u3n_slam_on(u3_noun gat, u3_noun sam)
+{
+ u3_noun cor = u3nc(u3k(u3h(gat)), u3nc(sam, u3k(u3t(u3t(gat)))));
+
+#if 0
+ if ( &u3H->rod_u == u3R ) {
+ if ( exc_w == 1 ) {
+ u3_assert(0);
+ }
+ exc_w++;
+ }
+#endif
+ u3z(gat);
+ return u3n_kick_on(cor);
+}
+
+/* u3n_nock_et(): produce .*(bus fol), as ++toon, in namespace.
+*/
+u3_noun
+u3n_nock_et(u3_noun gul, u3_noun bus, u3_noun fol)
+{
+ return u3m_soft_run(gul, u3n_nock_on, bus, fol);
+}
+
+/* u3n_slam_et(): produce (gat sam), as ++toon, in namespace.
+*/
+u3_noun
+u3n_slam_et(u3_noun gul, u3_noun gat, u3_noun sam)
+{
+ return u3m_soft_run(gul, u3n_slam_on, gat, sam);
+}
+
+/* u3n_nock_an(): as nock_et(), but with the scry handler that always blocks.
+*/
+u3_noun
+u3n_nock_an(u3_noun bus, u3_noun fol)
+{
+ u3_noun gul = u3nt(u3nc(1, 0), u3nc(0, 0), 0); // |~(^ ~)
+ return u3n_nock_et(gul, bus, fol);
+}
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-16 08:26:33 +0000