diff --git a/pkg/noun/imprison.c b/pkg/noun/imprison.c index 1ff8200790..143878e48e 100644 --- a/pkg/noun/imprison.c +++ b/pkg/noun/imprison.c @@ -149,6 +149,21 @@ u3i_slab_from(u3i_slab* sab_u, u3_atom a, c3_g met_g, c3_d len_d) // copies [a], zero-initializes any additional space // u3r_words(0, sab_u->len_w, sab_u->buf_w, a); + + // if necessary, mask off extra most-significant bits + // from most-significant word + // + if ( (5 > met_g) && (u3r_met(5, a) >= sab_u->len_w) ) { + // NB: overflow already checked in _ci_slab_size() + // + c3_d bit_d = len_d << met_g; + c3_w wor_w = bit_d >> 5; + c3_w bit_w = bit_d & 0x1f; + + if ( bit_w ) { + sab_u->buf_w[wor_w] &= ((c3_w)1 << bit_w) - 1; + } + } } /* u3i_slab_grow(): resize slab, zero-initializing new space. diff --git a/pkg/noun/jets/c/cap.c b/pkg/noun/jets/c/cap.c index c7edfbeb2e..95bef1fe95 100644 --- a/pkg/noun/jets/c/cap.c +++ b/pkg/noun/jets/c/cap.c @@ -5,32 +5,21 @@ #include "noun.h" +u3_noun +u3qc_cap(u3_atom a) +{ + c3_w met_w = u3r_met(0, a); - u3_noun - u3qc_cap(u3_atom a) - { - c3_w met_w = u3r_met(0, a); - - if ( met_w < 2 ) { - return u3m_bail(c3__exit); - } - else if ( (1 == u3r_bit((met_w - 2), a)) ) { - return 3; - } else { - return 2; - } + if ( 2 > met_w ) { + return u3m_bail(c3__exit); } - u3_noun - u3wc_cap(u3_noun cor) - { - u3_noun a; - - if ( (u3_none == (a = u3r_at(u3x_sam, cor))) || - (c3n == u3ud(a)) ) - { - return u3m_bail(c3__exit); - } else { - return u3qc_cap(a); - } + else { + return 2 + u3r_bit((met_w - 2), a); } +} +u3_noun +u3wc_cap(u3_noun cor) +{ + return u3qc_cap(u3x_atom(u3x_at(u3x_sam, cor))); +} diff --git a/pkg/noun/jets/c/mas.c b/pkg/noun/jets/c/mas.c index 7b2658d738..b0be6e1ae1 100644 --- a/pkg/noun/jets/c/mas.c +++ b/pkg/noun/jets/c/mas.c @@ -1,45 +1,48 @@ -/// @file - #include "jets/q.h" #include "jets/w.h" #include "noun.h" +u3_noun +u3qc_mas(u3_atom a) +{ + c3_w b_w; - u3_noun - u3qc_mas(u3_atom a) - { - c3_w b_w; - u3_atom c, d, e, f; + if ( c3y == u3a_is_cat(a) ) { + b_w = c3_bits_word(a); - b_w = u3r_met(0, a); - if ( b_w < 2 ) { + if ( 2 > b_w ) { return u3m_bail(c3__exit); } else { - c = u3qc_bex((b_w - 1)); - d = u3qc_bex((b_w - 2)); - e = u3qa_sub(a, c); - f = u3qc_con(e, d); - - u3z(c); - u3z(d); - u3z(e); - - return f; + a &= ~((c3_w)1 << (b_w - 1)); + a |= ((c3_w)1 << (b_w - 2)); + return a; } } - u3_noun - u3wc_mas(u3_noun cor) - { - u3_noun a; - - if ( (u3_none == (a = u3r_at(u3x_sam, cor))) || - (c3n == u3ud(a)) ) - { - return u3m_bail(c3__exit); - } else { - return u3qc_mas(a); + else { + b_w = u3r_met(0, a); + + if ( 64 > b_w ) { + c3_d a_d = u3r_chub(0, a); + a_d &= ~((c3_d)1 << (b_w - 1)); + a_d |= ((c3_d)1 << (b_w - 2)); + return u3i_chub(a_d); + } + else { + u3i_slab sab_u; + u3i_slab_from(&sab_u, a, 0, b_w - 1); + + b_w -= 2; + sab_u.buf_w[(b_w >> 5)] |= ((c3_w)1 << (b_w & 31)); + + return u3i_slab_mint(&sab_u); } } +} +u3_noun +u3wc_mas(u3_noun cor) +{ + return u3qc_mas(u3x_atom(u3x_at(u3x_sam, cor))); +} diff --git a/pkg/noun/jets/c/peg.c b/pkg/noun/jets/c/peg.c index 28a8f3b2bd..a700752e28 100644 --- a/pkg/noun/jets/c/peg.c +++ b/pkg/noun/jets/c/peg.c @@ -1,50 +1,66 @@ -/// @file - #include "jets/q.h" #include "jets/w.h" #include "noun.h" +u3_noun +u3qc_peg(u3_atom a, u3_atom b) +{ + if ( (0 == a) || (0 == b) ) { + return u3m_bail(c3__exit); + } + else if ( 1 == b ) { + return u3k(a); + } - u3_noun - u3qc_peg(u3_atom a, - u3_atom b) - { - if ( 1 == b ) { - return u3k(a); - } + c3_d a_d, b_d; + c3_w c_w; - u3_atom c, d, e, f, g, h; + if ( (c3y == u3a_is_cat(a)) && (c3y == u3a_is_cat(b)) ) { + c_w = c3_bits_word(b) - 1; + a_d = a; + b_d = b; + } + else { + c3_w d_w = u3r_met(0, a); + c3_d e_d; - c = u3r_met(0, b); - d = u3qa_dec(c); - e = u3qc_lsh(0, d, 1); - f = u3qa_sub(b, e); - g = u3qc_lsh(0, d, a); - h = u3qa_add(f, g); + c_w = u3r_met(0, b) - 1; + e_d = (c3_d)c_w + d_w; - u3z(c); - u3z(d); - u3z(e); - u3z(f); - u3z(g); + if ( 64 <= e_d ) { + u3i_slab sab_u; + u3i_slab_init(&sab_u, 0, e_d); - return h; - } - u3_noun - u3wc_peg(u3_noun cor) - { - u3_noun a, b; - - if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) || - (0 == a) || - (0 == b) || - (c3n == u3ud(b)) || - (c3n == u3ud(a) && b != 1) ) - { - return u3m_bail(c3__exit); - } else { - return u3qc_peg(a, b); + u3r_chop(0, 0, c_w, 0, sab_u.buf_w, b); + u3r_chop(0, 0, d_w, c_w, sab_u.buf_w, a); + + return u3i_slab_moot(&sab_u); } + + a_d = u3r_chub(0, a); + b_d = u3r_chub(0, b); } + b_d &= ((c3_d)1 << c_w) - 1; + a_d <<= c_w; + a_d ^= b_d; + + return u3i_chub(a_d); +} + +u3_noun +u3wc_peg(u3_noun cor) +{ + u3_noun a, b; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) || + (c3n == u3ud(b)) || + (c3n == u3ud(a) && b != 1) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qc_peg(a, b); + } +} diff --git a/pkg/noun/jets_tests.c b/pkg/noun/jets_tests.c index 257ec81e3b..222b31afbf 100644 --- a/pkg/noun/jets_tests.c +++ b/pkg/noun/jets_tests.c @@ -860,6 +860,71 @@ _test_ob(void) return ret_i; } +static c3_i +_test_mas(void) +{ + c3_i ret_i = 1; + u3_atom res; + + if ( 0x4000 != (res = u3qc_mas(0x8000)) ) { + fprintf(stderr, "test mas fail: (mas 0x8000) != 0x4000: 0x'%x'\r\n", res); + ret_i = 0; + } + + if ( 0x20000000 != (res = u3qc_mas(0x40000000)) ) { + fprintf(stderr, "test mas fail: (mas 0x4000.0000) != 0x2000.0000: 0x%x\r\n", res); + ret_i = 0; + } + + { + u3_atom sam, pro; + + sam = u3qc_bex(36); + pro = u3qc_bex(35); + res = u3qc_mas(sam); + + if ( c3n == u3r_sing(pro, res) ) { + c3_c* out_c; + u3s_etch_ux_c(res, &out_c); + fprintf(stderr, "test mas fail: (mas (bex 36)) != (bex 35): %s\r\n", out_c); + c3_free(out_c); + ret_i = 0; + } + + u3z(res); u3z(sam); u3z(pro); + + sam = u3qc_bex(64); + pro = u3qc_bex(63); + res = u3qc_mas(sam); + + if ( c3n == u3r_sing(pro, res) ) { + c3_c* out_c; + u3s_etch_ux_c(res, &out_c); + fprintf(stderr, "test mas fail: (mas (bex 64)) != (bex 63): %s\r\n", out_c); + c3_free(out_c); + ret_i = 0; + } + + u3z(res); u3z(sam); u3z(pro); + + sam = u3qc_bex(65); + pro = u3qc_bex(64); + res = u3qc_mas(sam); + + if ( c3n == u3r_sing(pro, res) ) { + c3_c* out_c; + u3s_etch_ux_c(res, &out_c); + fprintf(stderr, "test mas fail: (mas (bex 65)) != (bex 64): %s\r\n", out_c); + c3_free(out_c); + ret_i = 0; + } + + u3z(res); u3z(sam); u3z(pro); + } + + return ret_i; +} + static c3_i _test_jets(void) { @@ -900,6 +965,11 @@ _test_jets(void) ret_i = 0; } + if ( !_test_mas() ) { + fprintf(stderr, "test jets: mas: failed\r\n"); + ret_i = 0; + } + return ret_i; }