diff options
| author | polwex <polwex@sortug.com> | 2025-10-05 21:56:51 +0700 |
|---|---|---|
| committer | polwex <polwex@sortug.com> | 2025-10-05 21:56:51 +0700 |
| commit | fcedfddf00b3f994e4f4e40332ac7fc192c63244 (patch) | |
| tree | 51d38e62c7bdfcc5f9a5e9435fe820c93cfc9a3d /vere/pkg/noun/nock.c | |
claude is gud
Diffstat (limited to 'vere/pkg/noun/nock.c')
| -rw-r--r-- | vere/pkg/noun/nock.c | 3268 |
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, ®_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); +} + + |