i have a new idea... stash

This commit is contained in:
Paul Driver 2018-02-07 10:26:06 -08:00
parent 2b7f5f23b3
commit 945371ae46

View File

@ -582,7 +582,7 @@ _n_emit(u3_noun *ops, u3_noun op)
} }
} }
static c3_s _n_comp(u3_noun*, u3_noun, c3_o); static c3_s _n_comp(u3_noun*, c3_o*, u3_noun, c3_o);
static u3_noun static u3_noun
_n_skip(c3_s len_s) _n_skip(c3_s len_s)
@ -604,8 +604,8 @@ _n_one(u3_noun* ops, c3_o* tos_o, u3_noun fol)
c3_s tot_s = 0; c3_s tot_s = 0;
u3_noun bok = u3_nul; u3_noun bok = u3_nul;
tot_s += _n_comp(&bok, &tos_o, fol, c3n); tot_s += _n_comp(&bok, tos_o, fol, c3n);
if ( c3n == tos_o ) { if ( c3n == *tos_o ) {
tot_s += _n_emit(ops, COPY); tot_s += _n_emit(ops, COPY);
} }
_n_apen(ops, bok); _n_apen(ops, bok);
@ -613,49 +613,47 @@ _n_one(u3_noun* ops, c3_o* tos_o, u3_noun fol)
return tot_s; return tot_s;
} }
/* _n_two(): emit one and two's ops, regarding and updating tos_o, /* _n_two(): _n_comp() helper for computing two products
* and managing the COPY/SWAP dance, pushing one's product * from a single subject
* and then two's. */ */
static c3_s static c3_s
_n_two(u3_noun* ops, c3_o* tos_o, u3_noun one, u3_noun two) _n_two(u3_noun* ops, c3_o* lev_o, u3_noun one, u3_noun two, c3_o cop_o)
{ {
c3_assert(c3y == u3du(one));
c3_assert(c3y == u3du(two));
c3_s tot_s = 0;
c3_o one_o = *tos_o,
two_o = one_o;
u3_noun one_bok = u3_nul, u3_noun one_bok = u3_nul,
two_bok = u3_nul; two_bok = u3_nul;
tot_s += _n_comp(&one_bok, &one_o, one, c3n); c3_s tot_s = 0;
tot_s += _n_comp(&two_bok, &two_o, two, c3n); c3_o one_o, two_o;
tot_s += _n_comp(&one_bok, &one_o, one, cop_o, c3n);
tot_s += _n_comp(&two_bok, &two_o, two, cop_o, c3n);
if ( c3y == one_o ) { if ( c3y == one_o ) {
if ( c3y == two_o ) { if ( c3y == two_o ) {
tot_s += _n_emit(ops, TOSS);
_n_apen(ops, one_bok); _n_apen(ops, one_bok);
_n_apen(ops, two_bok); _n_apen(ops, two_bok);
*lev_o = c3y;
} }
else { else {
_n_apen(ops, one_bok); _n_apen(ops, one_bok);
tot_s += _n_emit(ops, SWAP); tot_s += _n_emit(ops, SWAP);
_n_apen(ops, two_bok); _n_apen(ops, two_bok);
*lev_o = c3n;
} }
*tos_o = two_o;
} }
else { else {
if ( c3y == two_o ) { if ( c3y == two_o ) {
_n_apen(one_bok); _n_apen(ops, one_bok);
_n_apen(two_bok); _n_apen(ops, two_bok);
*lev_o = c3n;
} }
else { else {
tot_s += _n_emit(ops, COPY); tot_s += _n_emit(ops, COPY);
_n_apen(one_bok); _n_apen(ops, one_bok);
tot_s += _n_emit(ops, SWAP); tot_s += _n_emit(ops, SWAP);
_n_apen(two_bok); _n_apen(ops, two_bok);
*lev_o = c3n;
} }
*tos_o = c3n;
} }
return tot_s; return tot_s;
@ -668,51 +666,34 @@ _n_two(u3_noun* ops, c3_o* tos_o, u3_noun one, u3_noun two)
static c3_s static c3_s
_n_bint(u3_noun* ops, c3_o* tos_o, u3_noun hif, u3_noun nef, c3_o tel_o) _n_bint(u3_noun* ops, c3_o* tos_o, u3_noun hif, u3_noun nef, c3_o tel_o)
{ {
*tos_o = c3n;
// XX todo: hints don't currently participate in optimization because it's
// complicated and i want to test it without them.
if ( c3n == u3du(hif) ) { if ( c3n == u3du(hif) ) {
// no currently recognized static hints // no currently recognized static hints
return _n_comp(ops, tos_o, nef, tel_o); return _n_comp(ops, tos_o, nef, tel_o);
} }
else { else {
c3_s bok_s, tot_s = 0; c3_s tot_s = 0;
c3_o bok_o; u3_noun zep, hod;
u3_noun zep, hod, bok;
u3x_cell(hif, &zep, &hod); u3x_cell(hif, &zep, &hod);
switch ( zep ) { switch ( zep ) {
default: default:
bok = u3_nul;
bok_o = *tos_o;
bok_s = _n_comp(&bok, &bok_o, nef, tel_o);
c3_assert(c3y == u3du(hod));
if ( 1 == u3h(hod) ) {
// safe to omit 1 hods because we would just toss them
// and they have no side effects
*tos_o = bok_o;
}
else {
*tos_o = bok_o;
tot_s += _n_one(ops, tos_o, hod); tot_s += _n_one(ops, tos_o, hod);
tot_s += _n_emit(ops, TOSS); tot_s += _n_emit(ops, TOSS);
if ( *tos_o != bok_o ) { tot_s += _n_comp(ops, tos_o, nef, tel_o);
u3z(bok);
bok = u3_nul;
bok_o = c3n;
bok_s = _n_comp(&bok, &bok_o, hif, c3n);
}
}
tot_s += bok_s; _n_apen(ops, bok);
break; break;
case c3__hunk: case c3__hunk:
case c3__lose: case c3__lose:
case c3__mean: case c3__mean:
case c3__spot: case c3__spot:
tot_s += _n_one(ops, hod); tot_s += _n_one(ops, tos_o, hod);
tot_s += _n_emit(ops, u3nc(QUIP, zep)); tot_s += _n_emit(ops, u3nc(QUIP, zep));
tot_s += _n_emit(ops, SNOC); tot_s += _n_emit(ops, SNOC);
tot_s += _n_emit(ops, CUSH); tot_s += _n_emit(ops, CUSH);
tot_s += _n_comp(ops, nef, c3n); tot_s += _n_comp(ops, tos_o, nef, c3n);
tot_s += _n_emit(ops, DROP); tot_s += _n_emit(ops, DROP);
break; break;
@ -722,7 +703,7 @@ _n_bint(u3_noun* ops, c3_o* tos_o, u3_noun hif, u3_noun nef, c3_o tel_o)
c3_s y_s = 0, c3_s y_s = 0,
n_s = 0; n_s = 0;
tot_s += _n_one(ops, hod); tot_s += _n_one(ops, tos_o, hod);
tot_s += _n_emit(ops, PEEP); tot_s += _n_emit(ops, PEEP);
n_s += _n_emit(&nop, HECK); n_s += _n_emit(&nop, HECK);
@ -734,20 +715,20 @@ _n_bint(u3_noun* ops, c3_o* tos_o, u3_noun hif, u3_noun nef, c3_o tel_o)
_n_apen(ops, yep); tot_s += y_s; _n_apen(ops, yep); tot_s += y_s;
_n_apen(ops, nop); tot_s += n_s; _n_apen(ops, nop); tot_s += n_s;
tot_s += _n_comp(ops, nef, tel_o); tot_s += _n_comp(ops, tos_o, nef, tel_o);
break; break;
} }
case c3__slog: case c3__slog:
tot_s += _n_one(ops, hod); tot_s += _n_one(ops, tos_o, hod);
tot_s += _n_emit(ops, SLOG); tot_s += _n_emit(ops, SLOG);
tot_s += _n_comp(ops, nef, tel_o); tot_s += _n_comp(ops, tos_o, nef, tel_o);
break; break;
// germ and sole are unused... // germ and sole are unused...
case c3__fast: case c3__fast:
tot_s += _n_two(ops, hod, nef); tot_s += _n_two(ops, tos_o, hod, nef);
tot_s += _n_emit(ops, FAST); tot_s += _n_emit(ops, FAST);
break; break;
@ -758,7 +739,7 @@ _n_bint(u3_noun* ops, c3_o* tos_o, u3_noun hif, u3_noun nef, c3_o tel_o)
c3_s y_s = 0, c3_s y_s = 0,
n_s = 0; // top->[bus] n_s = 0; // top->[bus]
tot_s += _n_emit(ops, COPY); // [bus bus] tot_s += _n_emit(ops, COPY); // [bus bus]
tot_s += _n_one(ops, hod); // [clue bus bus] tot_s += _n_one(ops, tos_o, hod); // [clue bus bus]
tot_s += _n_emit(ops, TOSS); // [bus bus] tot_s += _n_emit(ops, TOSS); // [bus bus]
tot_s += _n_emit(ops, u3nc(QUIP, u3k(nef))); // [fol bus bus] tot_s += _n_emit(ops, u3nc(QUIP, u3k(nef))); // [fol bus bus]
tot_s += _n_emit(ops, SNOC); // [[bus fol] bus] tot_s += _n_emit(ops, SNOC); // [[bus fol] bus]
@ -768,7 +749,7 @@ _n_bint(u3_noun* ops, c3_o* tos_o, u3_noun hif, u3_noun nef, c3_o tel_o)
// NO branch, i.e. gemo gave us ~ // NO branch, i.e. gemo gave us ~
n_s += _n_emit(&nop, TOSS); // [key bus] n_s += _n_emit(&nop, TOSS); // [key bus]
n_s += _n_emit(&nop, SWAP); // [bus key] n_s += _n_emit(&nop, SWAP); // [bus key]
n_s += _n_comp(&nop, nef, c3n); // [pro key] n_s += _n_comp(&nop, tos_o, nef, c3n); // [pro key]
n_s += _n_emit(&nop, PUMO); n_s += _n_emit(&nop, PUMO);
// YES branch, i.e. gemo gave us [0 pro] // YES branch, i.e. gemo gave us [0 pro]
@ -789,31 +770,30 @@ _n_bint(u3_noun* ops, c3_o* tos_o, u3_noun hif, u3_noun nef, c3_o tel_o)
} }
} }
/* _n_comp(): emit instructions from fol to ops. /* _n_comp(): compile nock formula to reversed opcode list
* tel_o indicates tail position. * ops is a pointer to a list (to be emitted to)
* fol is RETAINED. * lev_o is written: c3y/n whether the operand is left on the stack
* * fol is the nock formula to compile. RETAIN.
* if *tos_o is c3y when called, attempt to emit instructions * cop_o indicates the subject/product stack position is a COPY
* that assume the subject is left off the top of the stack, * if this is taken advantage of (lev_o), the caller should
* writing *tos_o = c3n when encountering instructions that cannot * omit the COPY
* ignore their subject. * tel_o is yes if this formula is in tail position
* return: the number of bytes needed for this opcode list
*/ */
static c3_s static c3_s
_n_comp(u3_noun* ops, c3_o* tos_o, u3_noun fol, c3_o tel_o) { _n_comp(u3_noun* ops, c3_o* lev_o, u3_noun fol, c3_o cop_o, c3_o tel_o) {
c3_s tot_s = 0; c3_s tot_s = 0;
c3_o n_o = c3n; c3_y op_y;
u3_noun cod, arg, hed, tel; u3_noun cod, arg, hed, tel;
u3x_cell(fol, &cod, &arg); u3x_cell(fol, &cod, &arg);
if ( c3y == u3du(cod) ) { if ( c3y == u3du(cod) ) {
tot_s += _n_two(ops, tos_o, cod, arg); tot_s += _n_two(ops, lev_o, cod, arg, cop_o);
tot_s += _n_emit(ops, CONS); tot_s += _n_emit(ops, CONS);
} }
else switch ( cod ) { else switch ( cod ) {
case 0: case 0:
if ( c3n == u3ud(arg) ) { c3_assert( c3y == u3ud(arg) );
return u3m_bail(c3__exit);
}
switch ( arg ) { switch ( arg ) {
case 0: case 0:
tot_s += _n_emit(ops, BAIL); tot_s += _n_emit(ops, BAIL);
@ -821,26 +801,29 @@ _n_comp(u3_noun* ops, c3_o* tos_o, u3_noun fol, c3_o tel_o) {
case 1: case 1:
break; break;
case 2: case 2:
tot_s += _n_emit(ops, HEAD); tot_s += _n_emit(ops, (c3y == cop_o) ? HELD : HEAD);
break; break;
case 3: case 3:
tot_s += _n_emit(ops, TAIL); tot_s += _n_emit(ops, (c3y == cop_o) ? TALL : TAIL);
break; break;
default: default:
tot_s += _n_emit(ops, u3nc( op_y = (c3y == cop_o)
(arg < 0xFF ? FRAB : arg < 0xFFFF ? FRAS : FRAG), ? (arg < 0xFF ? GRAB : arg < 0xFFFF ? GRAS : GRAN)
arg)); : (arg < 0xFF ? FRAG : arg < 0xFFFF ? FRAS : FRAG);
tot_s += _n_emit(ops, u3nc(op_y, arg));
break; break;
} }
*tos_o = c3n; *lev_o = cop_o;
break; break;
case 1: case 1:
tot_s += _n_emit(ops, u3nc(((c3y == *tos_o) ? QUIP : QUOT), u3k(arg))); op_y = (c3y == cop_o) ? QUIP : QUOT;
tot_s += _n_emit(ops, u3nc(op_y, u3k(arg)));
*lev_o = cop_o;
break; break;
case 2: case 2:
u3x_cell(arg, &hed, &tel); u3x_cell(arg, &hed, &tel);
tot_s += _n_two(ops, tos_o, hed, tel); tot_s += _n_two(ops, lev_o, hed, tel, cop_o);
tot_s += _n_emit(ops, ((c3y == tel_o)? NOCT : NOCK)); tot_s += _n_emit(ops, (c3y == tel_o)? NOCT : NOCK);
break; break;
case 3: case 3:
tot_s += _n_comp(ops, tos_o, arg, c3n); tot_s += _n_comp(ops, tos_o, arg, c3n);
@ -857,7 +840,7 @@ _n_comp(u3_noun* ops, c3_o* tos_o, u3_noun fol, c3_o tel_o) {
break; break;
case 6: { case 6: {
u3_noun mid, tes, yep, nop; u3_noun mid, tes, yep, nop;
c3_s yep_s, nop_s; c3_s yep_s, nop_s, tes_s;
c3_o ban_o, yep_o, nop_o; c3_o ban_o, yep_o, nop_o;
u3x_trel(arg, &hed, &mid, &tel); u3x_trel(arg, &hed, &mid, &tel);
@ -876,11 +859,13 @@ _n_comp(u3_noun* ops, c3_o* tos_o, u3_noun fol, c3_o tel_o) {
else { else {
if ( c3y == yep_o ) { if ( c3y == yep_o ) {
u3z(yep); u3z(yep);
yep_s = n_comp(&yep, &n_o, mid, tel_o); yep = u3_nul;
yep_s = _n_comp(&yep, &n_o, mid, tel_o);
} }
else { else {
u3z(no); u3z(nop);
nop_s = n_comp(&nop, &n_o, tel, tel_o); nop = u3_nul;
nop_s = _n_comp(&nop, &n_o, tel, tel_o);
} }
ban_o = c3n; ban_o = c3n;
} }
@ -1107,7 +1092,8 @@ static inline c3_y*
_n_bite(u3_noun fol) _n_bite(u3_noun fol)
{ {
u3_noun bok = u3_nul; u3_noun bok = u3_nul;
c3_s len_s = _n_comp(&bok, fol, c3y); c3_o tos_o = c3n;
c3_s len_s = _n_comp(&bok, &tos_o, fol, c3y);
c3_y* buf_y = _n_asm(bok, len_s); c3_y* buf_y = _n_asm(bok, len_s);
u3m_p("fol", fol); u3m_p("fol", fol);
_n_print_byc(buf_y); _n_print_byc(buf_y);