diff --git a/include/noun/allocate.h b/include/noun/allocate.h index 23fd55891..11199014d 100644 --- a/include/noun/allocate.h +++ b/include/noun/allocate.h @@ -250,6 +250,15 @@ ? u3a_north_is_senior(r, som) \ : u3a_south_is_senior(r, som) ) +# define u3a_is_mutable(r, som) \ + ( _(u3a_is_atom(som)) \ + ? c3n \ + : _(u3a_is_senior(r, som)) \ + ? c3n \ + : _(u3a_is_junior(r, som)) \ + ? c3n \ + : (u3a_botox(u3a_to_ptr(som))->use_w == 1) \ + ? c3y : c3n ) /** Globals. **/ diff --git a/include/noun/imprison.h b/include/noun/imprison.h index efda35fab..f552c87f5 100644 --- a/include/noun/imprison.h +++ b/include/noun/imprison.h @@ -55,6 +55,14 @@ u3_noun u3i_qual(u3_noun a, u3_noun b, u3_noun c, u3_noun d); + /* u3i_edit(): + ** + ** Mutate `big` at axis `axe` with new value `som` + ** `axe` is RETAINED. + */ + u3_noun + u3i_edit(u3_noun big, u3_noun axe, u3_noun som); + /* u3i_string(): ** ** Produce an LSB-first atom from the C string `a`. diff --git a/jets/f/hike.c b/jets/f/hike.c index 567b1ca0d..6b1bb5b36 100644 --- a/jets/f/hike.c +++ b/jets/f/hike.c @@ -89,6 +89,7 @@ u3qf_hike(u3_noun axe, u3_noun pac) { + c3_assert(0); if ( (u3_nul == pac) ) { return u3nc(0, u3k(axe)); } diff --git a/noun/imprison.c b/noun/imprison.c index 09126c14f..daf59a1d3 100644 --- a/noun/imprison.c +++ b/noun/imprison.c @@ -262,6 +262,150 @@ u3i_qual(u3_noun a, u3_noun b, u3_noun c, u3_noun d) return u3i_cell(a, u3i_trel(b, c, d)); } +static u3_noun +_edit_cat(u3_noun big, c3_l axe_l, u3_noun som) +{ + if ( c3n == u3du(big) ) { + return u3m_bail(c3__exit); + } + else { + u3_noun pro; + switch ( axe_l ) { + case 2: + pro = u3nc(som, u3k(u3t(big))); + break; + case 3: + pro = u3nc(u3k(u3h(big)), som); + break; + default: { + c3_l mor_l = u3x_mas(axe_l); + pro = ( 2 == u3x_cap(axe_l) ) + ? u3nc(_edit_cat(u3k(u3h(big)), mor_l, som), u3k(u3t(big))) + : u3nc(u3k(u3h(big)), _edit_cat(u3k(u3t(big)), mor_l, som)); + break; + } + } + u3z(big); + return pro; + } +} + +static u3_noun +_edit(u3_noun big, u3_noun axe, u3_noun som) +{ + if ( c3y == u3a_is_cat(axe) ) { + return _edit_cat(big, (c3_l) axe, som); + } + else if ( c3n == u3du(big) ) { + return u3m_bail(c3__exit); + } + else { + u3_noun mor = u3qc_mas(axe), + pro = ( 2 == u3qc_cap(axe) ) + ? u3nc(_edit(u3k(u3h(big)), mor, som), u3k(u3t(big))) + : u3nc(u3k(u3h(big)), _edit(u3k(u3t(big)), mor, som)); + u3z(mor); + u3z(big); + return pro; + } +} + +static u3_noun _edit_or_mutate_cat(u3_noun, c3_l, u3_noun); +static u3_noun _edit_or_mutate(u3_noun, u3_noun, u3_noun); + +static void +_mutate_cat(u3_noun big, c3_l axe_l, u3_noun som) +{ + if ( c3n == u3du(big) ) { + u3m_bail(c3__exit); + } + else { + u3a_cell* cel_u = (void*) u3a_to_ptr(big); + switch ( axe_l ) { + case 2: + u3z(cel_u->hed); + cel_u->hed = som; + break; + case 3: + u3z(cel_u->tel); + cel_u->tel = som; + break; + default: { + u3_noun* tar = ( 2 == u3x_cap(axe_l) ) + ? &(cel_u->hed) + : &(cel_u->tel); + *tar = _edit_or_mutate_cat(*tar, u3x_mas(axe_l), som); + } + } + } +} + +static void +_mutate(u3_noun big, u3_noun axe, u3_noun som) +{ + if ( c3y == u3a_is_cat(axe) ) { + _mutate_cat(big, (c3_l) axe, som); + } + else if ( c3n == u3du(big) ) { + u3m_bail(c3__exit); + } + else { + u3a_cell* cel_u = (void*) u3a_to_ptr(big); + u3_noun mor = u3qc_mas(axe); + u3_noun* tar = ( 2 == u3qc_cap(axe) ) + ? &(cel_u->hed) + : &(cel_u->tel); + *tar = _edit_or_mutate(*tar, mor, som); + u3z(mor); + } +} + +static u3_noun +_edit_or_mutate_cat(u3_noun big, c3_l axe_l, u3_noun som) +{ + if ( c3y == u3a_is_mutable(u3R, big) ) { + _mutate_cat(big, axe_l, som); + return big; + } + else { + return _edit_cat(big, axe_l, som); + } +} + +static u3_noun +_edit_or_mutate(u3_noun big, u3_noun axe, u3_noun som) +{ + if ( c3y == u3a_is_cat(axe) ) { + return _edit_or_mutate_cat(big, (c3_l) axe, som); + } + else if ( c3y == u3a_is_mutable(u3R, big) ) { + _mutate(big, axe, som); + return big; + } + else { + return _edit(big, axe, som); + } +} + +/* u3i_edit(): +** +** Mutate `big` at axis `axe` with new value `som`. +** `axe` is RETAINED. +*/ +u3_noun +u3i_edit(u3_noun big, u3_noun axe, u3_noun som) +{ + switch ( axe ) { + case 0: + return u3m_bail(c3__exit); + case 1: + u3z(big); + return som; + default: + return _edit_or_mutate(big, axe, som); + } +} + /* u3i_string(): ** ** Produce an LSB-first atom from the C string `a`. diff --git a/noun/nock.c b/noun/nock.c index 459f6cb2e..b1af247b7 100644 --- a/noun/nock.c +++ b/noun/nock.c @@ -526,6 +526,22 @@ _n_nock_on(u3_noun bus, u3_noun fol) #define SLIB 70 #define SLIS 71 #define SAVE 72 +// nock 12 +#define MUTH 73 +#define KUTH 74 +#define MUTT 75 +#define KUTT 76 +#define MUSM 77 +#define KUSM 78 +#define MUTB 79 +#define MUTS 80 +#define MITB 81 +#define MITS 82 +#define KUTB 83 +#define KUTS 84 +#define KITB 85 +#define KITS 86 +#define LAST 87 /* _n_arg(): return the size (in bytes) of an opcode's argument */ @@ -538,6 +554,7 @@ _n_arg(c3_y cod_y) 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: return sizeof(c3_y); case FASK: case FASL: case FISL: case FISK: @@ -545,13 +562,14 @@ _n_arg(c3_y cod_y) 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: return sizeof(c3_s); case SWIP: case SWIN: return sizeof(c3_l); default: - c3_assert( cod_y <= SAVE ); + c3_assert( cod_y < LAST ); return 0; } } @@ -657,6 +675,7 @@ _n_melt(u3_noun ops, c3_w* byc_w, c3_w* cal_w, case BUSH: case FIBK: case FIBL: case SANB: case LIBL: case LIBK: + case KITB: case MITB: a_w = (*lit_w)++; if ( a_w <= 0xFF ) { siz_y[i_w] = 2; @@ -854,6 +873,7 @@ _n_prog_asm(u3_noun ops, u3n_prog* pog_u, u3_noun sip) /* 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; @@ -862,6 +882,7 @@ _n_prog_asm(u3_noun ops, u3n_prog* pog_u, u3_noun sip) /* 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); @@ -885,6 +906,7 @@ _n_prog_asm(u3_noun ops, u3n_prog* pog_u, u3_noun sip) case FIBK: case FIBL: case LIBK: case LIBL: case BUSH: case SANB: + case KITB: case MITB: _n_prog_asm_inx(buf_y, &i_w, lit_s, cod); pog_u->lit_u.non[lit_s++] = u3k(u3t(op)); break; @@ -992,6 +1014,10 @@ static char* opcode_names[] = { "balt", "salt", "skib", "skis", "slib", "slis", "save", + "muth", "kuth", "mutt", "kutt", + "musm", "kusm", + "mutb", "muts", "mitb", "mits", + "kutb", "kuts", "kitb", "kits", }; #endif @@ -1289,6 +1315,38 @@ _n_comp(u3_noun* ops, u3_noun fol, c3_o los_o, c3_o tel_o) ++tot_w; _n_emit(ops, (c3y == los_o) ? WILS : WISH); break; + case 12: { + 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, c3n, 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; + } + default: u3m_bail(c3__exit); return 0; @@ -1573,6 +1631,10 @@ _n_burn(u3n_prog* pog_u, u3_noun bus, c3_ys mov, c3_ys off) &&do_balt, &&do_salt, &&do_skib, &&do_skis, &&do_slib, &&do_slis, &&do_save, + &&do_muth, &&do_kuth, &&do_mutt, &&do_kutt, + &&do_musm, &&do_kusm, + &&do_mutb, &&do_muts, &&do_mitb, &&do_mits, + &&do_kutb, &&do_kuts, &&do_kitb, &&do_kits, }; u3j_site* sit_u; @@ -2158,6 +2220,89 @@ _n_burn(u3n_prog* pog_u, u3_noun bus, c3_ys mov, c3_ys off) *top = x; u3z(o); BURN(); + + do_kuth: + x = _n_pep(mov, off); + top = _n_swap(mov, off); + goto muth_in; + do_muth: + x = _n_pep(mov, off); + _n_toss(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); + _n_toss(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); + _n_toss(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); + _n_toss(mov, off); + top = _n_peek(off); + edit_in: + *top = u3i_edit(*top, x, o); + BURN(); } }