u3: updates +rep and +rip jets to take a $bite

This commit is contained in:
Joe Bryan 2020-12-01 17:52:03 -08:00
parent b27806769e
commit e9937b306e
10 changed files with 397 additions and 150 deletions

View File

@ -43,12 +43,16 @@
/* u3kc_rep(): assemble single.
*/
u3_noun
u3kc_rep(u3_atom a, u3_noun b);
u3kc_rep(u3_atom a,
u3_atom b,
u3_noun c);
/* u3kc_rip(): disassemble.
*/
u3_noun
u3kc_rip(u3_atom a, u3_atom b);
u3kc_rip(u3_atom a,
u3_atom b,
u3_atom c);
/* u3kc_rev(): reverse block order, accounting for leading zeroes.
*/

View File

@ -63,9 +63,9 @@
u3_noun u3qc_peg(u3_atom, u3_atom);
u3_noun u3qc_pow(u3_atom, u3_atom);
u3_noun u3qc_rap(u3_atom, u3_noun);
u3_noun u3qc_rep(u3_atom, u3_noun);
u3_noun u3qc_rep(u3_atom, u3_atom, u3_noun);
u3_noun u3qc_rev(u3_atom, u3_atom, u3_atom);
u3_noun u3qc_rip(u3_atom, u3_atom);
u3_noun u3qc_rip(u3_atom, u3_atom, u3_atom);
u3_noun u3qc_rsh(u3_atom, u3_atom, u3_atom);
u3_noun u3qc_swp(u3_atom, u3_atom);
u3_noun u3qc_sqt(u3_atom);

View File

@ -188,6 +188,11 @@
u3_noun* b,
u3_noun* c);
/* u3r_bite(): retrieve/default $bloq and $step from $bite.
*/
c3_o
u3r_bite(u3_noun bite, u3_atom* bloq, u3_atom *step);
/* u3r_cell():
**
** Divide `a` as a cell `[b c]`.

View File

@ -98,6 +98,11 @@
void
u3x_mean(u3_noun a, ...);
/* u3x_bite(): xtract/default $bloq and $step from $bite.
*/
void
u3x_bite(u3_noun bite, u3_atom* bloq, u3_atom *step);
/* u3x_cell():
**
** Divide `a` as a cell `[b c]`.

View File

@ -3,92 +3,194 @@
*/
#include "all.h"
/* functions
/*
Get the lowest `n` bits of a word `w` using a bitmask.
*/
u3_noun
u3qc_rep(u3_atom a,
u3_noun b)
#define TAKEBITS(n,w) \
((n)==32) ? (w) : \
((n)==0) ? 0 : \
((w) & ((1 << (n)) - 1))
/*
Divide, rounding up.
*/
#define DIVCEIL(x,y) \
(x==0) ? 0 : \
1 + ((x - 1) / y);
static u3_noun
_bit_rep(u3_atom bits, u3_noun blox)
{
if ( (c3n == u3a_is_cat(bits) || bits==0 || bits>31) ) {
return u3m_bail(c3__fail);
}
//
// Calculate input and output size.
//
c3_w num_blox_w = u3qb_lent(blox);
c3_w bit_widt_w = num_blox_w * bits;
c3_w wor_widt_w = DIVCEIL(bit_widt_w, 32);
u3i_slab sab_u;
u3i_slab_bare(&sab_u, 5, wor_widt_w);
//
// Fill the atom buffer with bits from each block.
//
// Bits are pushed into the `acc_w` register and flushed to the buffer
// once full.
//
// acc_w register
// use_w number of register bits filled (used)
// cur_w next buffer word to flush into.
//
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__exit);
c3_w acc_w=0, use_w=0, *cur_w=sab_u.buf_w;
# define FLUSH() *cur_w++=acc_w; acc_w=use_w=0
# define SLICE(sz,off,val) TAKEBITS(sz, val) << off
for (c3_w i=0; i<num_blox_w; i++) {
u3_noun blok_n = u3h(blox);
blox = u3t(blox);
if ( c3n == u3a_is_cat(blok_n) ) {
return u3m_bail(c3__fail);
}
c3_w blok_w = blok_n;
for (c3_w rem_in_blok_w=bits; rem_in_blok_w;) {
c3_w rem_in_acc_w = 32 - use_w;
if (rem_in_blok_w == rem_in_acc_w) { // EQ
acc_w |= SLICE(rem_in_blok_w, use_w, blok_w);
FLUSH();
rem_in_blok_w = 0;
}
else if (rem_in_blok_w < rem_in_acc_w) { // LT
acc_w |= SLICE(rem_in_blok_w, use_w, blok_w);
use_w += rem_in_blok_w;
rem_in_blok_w = 0;
}
else { // GT
acc_w |= SLICE(rem_in_acc_w, use_w, blok_w);
rem_in_blok_w -= rem_in_acc_w;
blok_w = blok_w >> rem_in_acc_w;
FLUSH();
}
}
}
else {
c3_g a_g = a;
c3_w tot_w = 0;
u3i_slab sab_u;
/* Measure and validate the slab required.
*/
{
u3_noun cab = b;
while ( 1 ) {
u3_noun h_cab;
c3_w len_w;
if ( 0 == cab ) {
break;
}
else if ( c3n == u3du(cab) ) {
return u3m_bail(c3__exit);
}
else if ( c3n == u3ud(h_cab = u3h(cab)) ) {
return u3m_bail(c3__exit);
}
else if ( (tot_w + (len_w = u3r_met(a_g, h_cab))) < tot_w ) {
return u3m_bail(c3__fail);
}
tot_w++;
cab = u3t(cab);
}
if ( 0 == tot_w ) {
return 0;
}
u3i_slab_init(&sab_u, a_g, tot_w);
}
/* Chop the list atoms in.
*/
{
u3_noun cab = b;
c3_w pos_w = 0;
while ( 0 != cab ) {
u3_noun h_cab = u3h(cab);
u3r_chop(a_g, 0, 1, pos_w, sab_u.buf_w, h_cab);
pos_w++;
cab = u3t(cab);
}
}
return u3i_slab_mint(&sab_u);
//
// If the last word isn't fully used, it will still need to be
// flushed.
//
if (use_w) {
FLUSH();
}
}
u3_noun
u3wc_rep(u3_noun cor)
{
u3_noun a, b;
if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) ||
(c3n == u3ud(a)) )
return u3i_slab_mint(&sab_u);
}
static u3_noun
_block_rep(u3_atom a,
u3_noun b)
{
if ( !_(u3a_is_cat(a)) || (a >= 32) ) {
return u3m_bail(c3__exit);
}
else {
c3_g a_g = a;
c3_w tot_w = 0;
u3i_slab sab_u;
/* Measure and validate the slab required.
*/
{
return u3m_bail(c3__exit);
} else {
u3_noun pro;
u3_noun cab = b;
pro = u3qc_rep(a, b);
return pro;
while ( 1 ) {
u3_noun h_cab;
c3_w len_w;
if ( 0 == cab ) {
break;
}
else if ( c3n == u3du(cab) ) {
return u3m_bail(c3__exit);
}
else if ( c3n == u3ud(h_cab = u3h(cab)) ) {
return u3m_bail(c3__exit);
}
else if ( (tot_w + (len_w = u3r_met(a_g, h_cab))) < tot_w ) {
return u3m_bail(c3__fail);
}
tot_w++;
cab = u3t(cab);
}
if ( 0 == tot_w ) {
return 0;
}
u3i_slab_init(&sab_u, a_g, tot_w);
}
/* Chop the list atoms in.
*/
{
u3_noun cab = b;
c3_w pos_w = 0;
while ( 0 != cab ) {
u3_noun h_cab = u3h(cab);
u3r_chop(a_g, 0, 1, pos_w, sab_u.buf_w, h_cab);
pos_w++;
cab = u3t(cab);
}
}
return u3i_slab_mint(&sab_u);
}
u3_noun
u3kc_rep(u3_atom a,
u3_noun b)
{
u3_noun res = u3qc_rep(a, b);
u3z(a); u3z(b);
return res;
}
u3_noun
u3qc_rep(u3_atom a,
u3_atom b,
u3_noun c)
{
if ( 1 == b ) {
return _block_rep(a, c);
}
if ( 0 == a ) {
return _bit_rep(b, c);
}
u3l_log("rep: stub\r\n");
return u3m_bail(c3__fail);
}
u3_noun
u3wc_rep(u3_noun cor)
{
u3_atom bloq, step;
u3_noun a, b;
u3x_mean(cor, u3x_sam_2, &a,
u3x_sam_3, &b, 0);
u3x_bite(a, &bloq, &step);
return u3qc_rep(bloq, step, b);
}
u3_noun
u3kc_rep(u3_atom a,
u3_atom b,
u3_noun c)
{
u3_noun res = u3qc_rep(a, b, c);
u3z(a); u3z(b); u3z(c);
return res;
}

View File

@ -1,6 +1,90 @@
#include "all.h"
u3_noun u3qc_rip(u3_atom bloq, u3_atom b) {
/*
Get the lowest `n` bits of a word `w` using a bitmask.
*/
#define TAKEBITS(n,w) \
((n)==32) ? (w) : \
((n)==0) ? 0 : \
((w) & ((1 << (n)) - 1))
/*
Divide, rounding up.
*/
#define DIVCEIL(x,y) \
(x==0) ? 0 : \
1 + ((x - 1) / y);
/*
`ripn` breaks `atom` into a list of blocks, of bit-width `bits`. The
resulting list will be least-significant block first.
XX TODO This only handles cases where the bit-width is <= 32.
For each block we produce, we need to grab the relevant words inside
`atom`, so we first compute their indicies.
`ins_idx` is the word-index of the least-significant word we
care about, and `sig_idx` is the word after that.
Next we grab those words (`ins_word` and `sig_word`) from the atom
using `u3r_word`. Note that `sig_idx` might be out-of-bounds for the
underlying array of `atom`, but `u3r_word` returns 0 in that case,
which is exatly what we want.
Now, we need to grab the relevant bits out of both words, and combine
them. `bits_rem_in_ins_word` is the number of remaining (insignificant)
bits in `ins_word`, `nbits_ins` is the number of bits we want from the
less-significant word, and `nbits_sig` from the more-significant one.
Take the least significant `nbits_sig` bits from `sig_word`, and take
the slice we care about from `ins_word`. In order to take that slice,
we drop `bits_rem_in_ins_word` insignificant bits, and then take the
`nbits_sig` most-significant bits.
Last, we slice out those bits from the two words, combine them into
one word, and cons them onto the front of the result.
*/
static u3_noun
_bit_rip(u3_atom bits, u3_atom atom)
{
if ( !_(u3a_is_cat(bits) || bits==0 || bits>31) ) {
return u3m_bail(c3__fail);
}
c3_w bit_width = u3r_met(0, atom);
c3_w num_blocks = DIVCEIL(bit_width, bits);
u3_noun res = u3_nul;
for ( c3_w blk = 0; blk < num_blocks; blk++ ) {
c3_w next_blk = blk + 1;
c3_w blks_rem = num_blocks - next_blk;
c3_w bits_rem = blks_rem * bits;
c3_w ins_idx = bits_rem / 32;
c3_w sig_idx = ins_idx + 1;
c3_w bits_rem_in_ins_word = bits_rem % 32;
c3_w ins_word = u3r_word(ins_idx, atom);
c3_w sig_word = u3r_word(sig_idx, atom);
c3_w nbits_ins = c3_min(bits, 32 - bits_rem_in_ins_word);
c3_w nbits_sig = bits - nbits_ins;
c3_w ins_word_bits = TAKEBITS(nbits_ins, ins_word >> bits_rem_in_ins_word);
c3_w sig_word_bits = TAKEBITS(nbits_sig, sig_word);
c3_w item = ins_word_bits | (sig_word_bits << nbits_ins);
res = u3nc(item, res);
}
return res;
}
static u3_noun
_block_rip(u3_atom bloq, u3_atom b)
{
if ( !_(u3a_is_cat(bloq)) || (bloq >= 32) ) {
return u3m_bail(c3__fail);
}
@ -62,21 +146,41 @@ u3_noun u3qc_rip(u3_atom bloq, u3_atom b) {
return acc;
}
u3_noun u3wc_rip(u3_noun cor) {
u3_noun a, b;
if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) ||
(c3n == u3ud(a)) ||
(c3n == u3ud(b))
) {
return u3m_bail(c3__exit);
u3_noun
u3qc_rip(u3_atom a,
u3_atom b,
u3_atom c)
{
if ( 1 == b ) {
return _block_rip(a, c);
}
return u3qc_rip(a, b);
if ( 0 == a ) {
return _bit_rip(b, c);
}
u3l_log("rip: stub\r\n");
return u3m_bail(c3__fail);
}
u3_noun u3kc_rip(u3_atom a, u3_atom b) {
u3_noun res = u3qc_rip(a, b);
u3z(a); u3z(b);
return res;
u3_noun
u3wc_rip(u3_noun cor)
{
u3_atom bloq, step;
u3_noun a, b;
u3x_mean(cor, u3x_sam_2, &a,
u3x_sam_3, &b, 0);
u3x_bite(a, &bloq, &step);
return u3qc_rip(bloq, step, u3x_atom(b));
}
u3_noun
u3kc_rip(u3_atom a,
u3_atom b,
u3_atom c)
{
u3_noun pro = u3qc_rip(a, b, c);
u3z(a); u3z(b); u3z(c);
return pro;
}

View File

@ -3,37 +3,35 @@
*/
#include "all.h"
/* functions
*/
u3_noun
u3qc_swp(u3_atom a,
u3_atom b)
{
//XX write a proper c-style swp, maybe
//
return u3kc_rep(u3k(a), 1, u3kb_flop(u3qc_rip(a, 1, b)));
}
u3_noun
u3qc_swp(u3_atom a,
u3_atom b)
u3_noun
u3wc_swp(u3_noun cor)
{
u3_noun a, b;
u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0);
if ( (c3n == u3ud(a))
|| (c3n == u3ud(b)) )
{
//XX write a proper c-style swp, maybe
return u3kc_rep(u3k(a), u3kb_flop(u3qc_rip(a, b)));
return u3m_bail(c3__exit);
}
u3_noun
u3wc_swp(u3_noun cor)
{
u3_noun a, b;
return u3qc_swp(a, b);
}
if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) ||
(c3n == u3ud(a)) ||
(c3n == u3ud(b)) )
{
return u3m_bail(c3__exit);
} else {
return u3qc_swp(a, b);
}
}
u3_noun
u3kc_swp(u3_atom a,
u3_atom b)
{
u3_noun res = u3qc_swp(a, b);
u3z(a); u3z(b);
return res;
}
u3_noun
u3kc_swp(u3_atom a,
u3_atom b)
{
u3_noun pro = u3qc_swp(a, b);
u3z(a); u3z(b);
return pro;
}

View File

@ -3,33 +3,28 @@
*/
#include "all.h"
u3_noun
u3qe_trip(u3_atom a)
{
return u3qc_rip(3, 1, a);
}
/* functions
*/
u3_noun
u3qe_trip(u3_atom a)
{
if ( c3n == u3ud(a) ) {
return u3m_bail(c3__exit);
}
return u3qc_rip(3, a);
}
u3_noun
u3we_trip(u3_noun cor)
{
u3_noun a;
u3_noun
u3we_trip(u3_noun cor)
{
u3_noun a = u3x_at(u3x_sam, cor);
if ( (u3_none == (a = u3r_at(u3x_sam, cor))) ) {
return u3m_bail(c3__fail);
} else {
return u3qe_trip(a);
}
if ( c3n == u3ud(a) ) {
return u3m_bail(c3__exit);
}
u3_atom
u3ke_trip(u3_noun a)
{
u3_atom b = u3qe_trip(a);
u3z(a);
return b;
}
return u3qe_trip(a);
}
u3_atom
u3ke_trip(u3_noun a)
{
u3_atom pro = u3qe_trip(a);
u3z(a);
return pro;
}

View File

@ -805,6 +805,30 @@ u3r_bush(u3_noun a,
}
}
/* u3r_bite(): retrieve/default $bloq and $step from $bite.
*/
c3_o
u3r_bite(u3_noun bite, u3_atom* bloq, u3_atom *step)
{
u3_noun hed, tal;
if ( c3n == u3r_cell(bite, &hed, &tal) ) {
*bloq = bite;
*step = 1;
return c3y;
}
else if ( (c3n == u3a_is_atom(hed))
|| (c3n == u3a_is_atom(tal)) )
{
return c3n;
}
else {
*bloq = hed;
*step = tal;
return c3y;
}
}
/* u3r_cell():
**
** Factor (a) as a cell (b c).

View File

@ -39,6 +39,16 @@ u3x_mean(u3_noun som, ...)
}
}
/* u3x_bite(): xtract/default $bloq and $step from $bite.
*/
void
u3x_bite(u3_noun bite, u3_atom* bloq, u3_atom *step)
{
if ( c3n == u3r_bite(bite, bloq, step) ) {
u3m_bail(c3__exit);
}
}
/* u3x_cell():
**
** Divide `a` as a cell `[b c]`.