mirror of
https://github.com/urbit/shrub.git
synced 2024-11-28 22:33:06 +03:00
913 lines
17 KiB
C
913 lines
17 KiB
C
/* f/bail.c
|
|
**
|
|
** This file is in the public domain.
|
|
*/
|
|
#include "all.h"
|
|
|
|
/* u2_bl_bail(): bail out.
|
|
**
|
|
** Bail codes:
|
|
**
|
|
** c3__exit for normal exit with correct trace
|
|
** c3__fail for abnormal failure without assumptions
|
|
**
|
|
** When in doubt, fail.
|
|
**
|
|
** In both cases, a gc is necessary to clean up leaks.
|
|
*/
|
|
u2_noun
|
|
u2_bl_bail(u2_wire wir_r,
|
|
c3_l how_l)
|
|
{
|
|
return u2_cm_bail(how_l);
|
|
}
|
|
|
|
/* u2_bl_push(): push on meaning stack.
|
|
*/
|
|
void
|
|
u2_bl_push(u2_wire wir_r,
|
|
u2_noun mon) // transfer
|
|
{
|
|
u2_noun tax = u2_rc(wir_r, mon, u2_rx(wir_r, u2_wire_tax(wir_r)));
|
|
|
|
if ( u2_none != tax ) {
|
|
u2_rz(wir_r, u2_wire_tax(wir_r));
|
|
u2_wire_tax(wir_r) = tax;
|
|
}
|
|
else u2_bl_bail(wir_r, c3__fail);
|
|
}
|
|
|
|
/* u2_bl_mean(): push `[%mean roc]` on trace stack.
|
|
*/
|
|
void
|
|
u2_bl_mean(u2_wire wir_r,
|
|
u2_noun roc) // transfer
|
|
{
|
|
return u2_bl_push(wir_r, u2_bc(wir_r, c3__mean, roc));
|
|
}
|
|
|
|
/* u2_bl_drop(): drop from meaning stack.
|
|
*/
|
|
void
|
|
u2_bl_drop(u2_wire wir_r)
|
|
{
|
|
u2_noun tax = u2_wire_tax(wir_r);
|
|
|
|
c3_assert(u2_yes == u2_dust(tax));
|
|
|
|
u2_wire_tax(wir_r) = u2_rx(wir_r, u2_t(tax));
|
|
u2_rz(wir_r, tax);
|
|
}
|
|
|
|
/* u2_bl_error(): simple string error.
|
|
*/
|
|
u2_noun
|
|
u2_bl_error(u2_wire wir_r,
|
|
const c3_c* err_c) // retain
|
|
{
|
|
u2_bl_push(wir_r, u2_bc(wir_r, c3__lose, u2_bn_string(wir_r, err_c)));
|
|
|
|
return u2_bl_bail(wir_r, c3__exit);
|
|
}
|
|
|
|
/* u2_bl_some(): test for zero ray.
|
|
*/
|
|
u2_ray
|
|
u2_bl_some(u2_wire wir_r,
|
|
u2_ray ray_r)
|
|
{
|
|
if ( 0 == ray_r ) {
|
|
return u2_bl_bail(wir_r, c3__fail);
|
|
}
|
|
else return ray_r;
|
|
}
|
|
|
|
/* u2_bl_good(): test for u2_none.
|
|
*/
|
|
u2_noun
|
|
u2_bl_good(u2_ray wir_r,
|
|
u2_weak som)
|
|
{
|
|
if ( u2_none == som ) {
|
|
return u2_bl_bail(wir_r, c3__exit);
|
|
}
|
|
else return som;
|
|
}
|
|
|
|
/* u2_bl_flat(): test for atom.
|
|
*/
|
|
u2_atom
|
|
u2_bl_flat(u2_ray wir_r,
|
|
u2_weak som)
|
|
{
|
|
if ( u2_none == som ) {
|
|
return u2_bl_bail(wir_r, c3__exit);
|
|
}
|
|
else return som;
|
|
}
|
|
|
|
/* u2_bi_h():
|
|
**
|
|
** Return the head of (a).
|
|
*/
|
|
u2_noun
|
|
u2_bi_h(u2_ray wir_r,
|
|
u2_noun a)
|
|
{
|
|
if ( u2_no == u2_dust(a) ) return u2_bl_bail(wir_r, c3__exit);
|
|
|
|
return u2_h(a);
|
|
}
|
|
|
|
/* u2_bi_t():
|
|
**
|
|
** Return the tail of (a).
|
|
*/
|
|
u2_noun
|
|
u2_bi_t(u2_ray wir_r,
|
|
u2_noun a)
|
|
{
|
|
if ( u2_no == u2_dust(a) ) return u2_bl_bail(wir_r, c3__exit);
|
|
|
|
return u2_t(a);
|
|
}
|
|
|
|
/* u2_bi_frag():
|
|
**
|
|
** Return fragment (a) of (b).
|
|
*/
|
|
u2_noun
|
|
u2_bi_frag(u2_ray wir_r,
|
|
u2_atom a,
|
|
u2_noun b)
|
|
{
|
|
u2_weak c = u2_frag(a, b);
|
|
|
|
if ( u2_none == c ) {
|
|
return u2_bl_bail(wir_r, c3__exit);
|
|
} else return c;
|
|
}
|
|
|
|
/* u2_bi_met():
|
|
**
|
|
** Return the size of (b) in bits, rounded up to
|
|
** (1 << a_y).
|
|
**
|
|
** For example, (a_y == 3) returns the size in bytes.
|
|
*/
|
|
c3_w
|
|
u2_bi_met(u2_ray wir_r,
|
|
c3_y a_y,
|
|
u2_noun b)
|
|
{
|
|
if ( u2_no == u2_stud(b) ) return u2_bl_bail(wir_r, c3__exit);
|
|
|
|
return u2_met(a_y, b);
|
|
}
|
|
|
|
/* u2_bi_bit():
|
|
**
|
|
** Return bit (a_w) of (b).
|
|
*/
|
|
c3_b
|
|
u2_bi_bit(u2_ray wir_r,
|
|
c3_w a_w,
|
|
u2_noun b)
|
|
{
|
|
if ( u2_no == u2_stud(b) ) return u2_bl_bail(wir_r, c3__exit);
|
|
|
|
return u2_bit(a_w, b);
|
|
}
|
|
|
|
/* u2_bi_byte():
|
|
**
|
|
** Return byte (a_w) of (b).
|
|
*/
|
|
c3_y
|
|
u2_bi_byte(u2_ray wir_r,
|
|
c3_w a_w,
|
|
u2_noun b)
|
|
{
|
|
if ( u2_no == u2_stud(b) ) return u2_bl_bail(wir_r, c3__exit);
|
|
|
|
return u2_byte(a_w, b);
|
|
}
|
|
|
|
/* u2_bi_bytes():
|
|
**
|
|
** Copy bytes (a_w) through (a_w + b_w - 1) from (d) to (c).
|
|
*/
|
|
void
|
|
u2_bi_bytes(u2_ray wir_r,
|
|
c3_w a_w,
|
|
c3_w b_w,
|
|
c3_y* c_y,
|
|
u2_noun d)
|
|
{
|
|
if ( u2_no == u2_stud(d) ) u2_bl_bail(wir_r, c3__exit);
|
|
|
|
u2_bytes(a_w, b_w, c_y, d);
|
|
}
|
|
|
|
/* u2_bi_mp():
|
|
**
|
|
** Copy (b) into (a_mp).
|
|
*/
|
|
void
|
|
u2_bi_mp(u2_ray wir_r,
|
|
mpz_t a_mp,
|
|
u2_noun b)
|
|
{
|
|
if ( u2_no == u2_stud(b) ) u2_bl_bail(wir_r, c3__exit);
|
|
|
|
u2_mp(a_mp, b);
|
|
}
|
|
|
|
/* u2_bi_word():
|
|
**
|
|
** Return word (a_w) of (b).
|
|
*/
|
|
c3_w
|
|
u2_bi_word(u2_ray wir_r,
|
|
c3_w a_w,
|
|
u2_noun b)
|
|
{
|
|
if ( u2_no == u2_stud(b) ) return u2_bl_bail(wir_r, c3__exit);
|
|
|
|
return u2_word(a_w, b);
|
|
}
|
|
|
|
/* u2_bi_words():
|
|
**
|
|
** Copy words (a_w) through (a_w + b_w - 1) from (d) to (c).
|
|
*/
|
|
void
|
|
u2_bi_words(u2_ray wir_r,
|
|
c3_w a_w,
|
|
c3_w b_w,
|
|
c3_w* c_w,
|
|
u2_noun d)
|
|
{
|
|
if ( u2_no == u2_stud(d) ) u2_bl_bail(wir_r, c3__exit);
|
|
|
|
u2_words(a_w, b_w, c_w, d);
|
|
}
|
|
|
|
/* u2_bn_bytes():
|
|
**
|
|
** Copy [a] bytes from [b].
|
|
*/
|
|
u2_noun
|
|
u2_bn_bytes(u2_ray wir_r,
|
|
c3_w a_w,
|
|
const c3_y* b_y)
|
|
{
|
|
return u2_bl_good(wir_r, u2_rl_bytes(wir_r, a_w, b_y));
|
|
}
|
|
|
|
/* u2_bn_string():
|
|
**
|
|
** u2_bn_bytes(wir_r, strlen(a_c), (c3_y *)a_c);
|
|
*/
|
|
u2_noun
|
|
u2_bn_string(u2_ray wir_r,
|
|
const c3_c* a_c)
|
|
{
|
|
return u2_bl_good(wir_r, u2_rl_string(wir_r, a_c));
|
|
}
|
|
|
|
/* u2_bn_cell():
|
|
**
|
|
** Produce the cell [a b].
|
|
*/
|
|
u2_noun
|
|
u2_bn_cell(u2_ray wir_r,
|
|
u2_noun a,
|
|
u2_noun b)
|
|
{
|
|
return u2_bl_good(wir_r, u2_rl_cell(wir_r, a, b));
|
|
}
|
|
|
|
/* u2_bn_ice():
|
|
**
|
|
** Produce `a`, not referencing the can. Copy or gain reference.
|
|
*/
|
|
u2_noun
|
|
u2_bn_ice(u2_ray wir_r,
|
|
u2_weak a)
|
|
{
|
|
return u2_bl_good(wir_r, u2_rl_ice(wir_r, u2_bl_good(wir_r, a)));
|
|
}
|
|
|
|
/* u2_bn_list():
|
|
**
|
|
** Generate a null-terminated list, with a 0 terminator.
|
|
*/
|
|
u2_noun
|
|
u2_bn_list(u2_ray wir_r, ...)
|
|
{
|
|
c3_w len_w = 0;
|
|
va_list vap;
|
|
|
|
/* Count.
|
|
*/
|
|
{
|
|
va_start(vap, wir_r);
|
|
while ( u2_none != va_arg(vap, u2_noun) ) {
|
|
len_w++;
|
|
}
|
|
va_end(vap);
|
|
}
|
|
|
|
/* Allocate.
|
|
*/
|
|
{
|
|
c3_w i_w;
|
|
u2_noun yit[len_w];
|
|
|
|
va_start(vap, wir_r);
|
|
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
|
yit[i_w] = va_arg(vap, u2_noun);
|
|
}
|
|
va_end(vap);
|
|
|
|
/* Construct.
|
|
*/
|
|
{
|
|
u2_noun woq = u2_nul;
|
|
|
|
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
|
woq = u2_bc(wir_r, yit[len_w - (i_w + 1)], woq);
|
|
}
|
|
return woq;
|
|
}
|
|
}
|
|
}
|
|
|
|
/* u2_bn_molt():
|
|
**
|
|
** Mutate `som` with a 0-terminated list of axis, noun pairs.
|
|
** Axes must be cats (31 bit).
|
|
**
|
|
** Caller retains arguments; function transfers result.
|
|
*/
|
|
struct _molt_pair {
|
|
c3_w axe_w;
|
|
u2_noun som;
|
|
};
|
|
|
|
static c3_w
|
|
_molt_cut(c3_w len_w,
|
|
struct _molt_pair* pms_m)
|
|
{
|
|
c3_w i_w, cut_t, cut_w;
|
|
|
|
cut_t = c3_false;
|
|
cut_w = 0;
|
|
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
|
c3_w axe_w = pms_m[i_w].axe_w;
|
|
|
|
if ( (cut_t == c3_false) && (3 == u2_ax_cap(axe_w)) ) {
|
|
cut_t = c3_true;
|
|
cut_w = i_w;
|
|
}
|
|
pms_m[i_w].axe_w = u2_ax_mas(axe_w);
|
|
}
|
|
return cut_t ? cut_w : i_w;
|
|
}
|
|
|
|
static u2_noun
|
|
_molt_apply(u2_wire wir_r,
|
|
u2_noun som,
|
|
c3_w len_w,
|
|
struct _molt_pair* pms_m)
|
|
{
|
|
if ( len_w == 0 ) {
|
|
return u2_rl_gain(wir_r, som);
|
|
}
|
|
else if ( (len_w == 1) && (1 == pms_m[0].axe_w) ) {
|
|
return u2_rl_gain(wir_r, pms_m[0].som);
|
|
}
|
|
else {
|
|
c3_w cut_w = _molt_cut(len_w, pms_m);
|
|
|
|
if ( u2_no == u2_dust(som) ) {
|
|
return u2_bc
|
|
(wir_r,
|
|
_molt_apply(wir_r, u2_nul, cut_w, pms_m),
|
|
_molt_apply(wir_r, u2_nul, (len_w - cut_w), (pms_m + cut_w)));
|
|
} else {
|
|
return u2_bc
|
|
(wir_r,
|
|
_molt_apply(wir_r, u2_h(som), cut_w, pms_m),
|
|
_molt_apply(wir_r, u2_t(som), (len_w - cut_w), (pms_m + cut_w)));
|
|
}
|
|
}
|
|
}
|
|
|
|
/* u2_bn_molf():
|
|
**
|
|
** As u2_bn_molt(), with argument pointer.
|
|
*/
|
|
u2_noun
|
|
u2_bn_molf(u2_wire wir_r,
|
|
u2_noun som,
|
|
va_list vap)
|
|
{
|
|
va_list vaq;
|
|
c3_w len_w;
|
|
struct _molt_pair* pms_m;
|
|
|
|
/* Count.
|
|
*/
|
|
len_w = 0;
|
|
{
|
|
va_copy(vaq, vap);
|
|
while ( 1 ) {
|
|
if ( 0 == va_arg(vaq, c3_w) ) {
|
|
break;
|
|
}
|
|
va_arg(vaq, u2_noun*);
|
|
len_w++;
|
|
}
|
|
va_end(vaq);
|
|
}
|
|
pms_m = alloca(len_w * sizeof(struct _molt_pair));
|
|
|
|
/* Install.
|
|
*/
|
|
{
|
|
c3_w i_w;
|
|
|
|
va_copy(vaq, vap);
|
|
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
|
pms_m[i_w].axe_w = va_arg(vaq, c3_w);
|
|
pms_m[i_w].som = va_arg(vaq, u2_noun);
|
|
}
|
|
va_end(vaq);
|
|
}
|
|
|
|
/* Apply.
|
|
*/
|
|
return _molt_apply(wir_r, som, len_w, pms_m);
|
|
}
|
|
|
|
/* u2_bn_molt():
|
|
**
|
|
** Mutate `som` with a 0-terminated list of axis, noun pairs.
|
|
** Axes must be cats (31 bit).
|
|
*/
|
|
u2_noun
|
|
u2_bn_molt(u2_wire wir_r,
|
|
u2_noun som,
|
|
...)
|
|
{
|
|
va_list ap;
|
|
c3_w len_w;
|
|
struct _molt_pair* pms_m;
|
|
|
|
/* Count.
|
|
*/
|
|
len_w = 0;
|
|
{
|
|
va_start(ap, som);
|
|
while ( 1 ) {
|
|
if ( 0 == va_arg(ap, c3_w) ) {
|
|
break;
|
|
}
|
|
va_arg(ap, u2_noun*);
|
|
len_w++;
|
|
}
|
|
va_end(ap);
|
|
}
|
|
pms_m = alloca(len_w * sizeof(struct _molt_pair));
|
|
|
|
/* Install.
|
|
*/
|
|
{
|
|
c3_w i_w;
|
|
|
|
va_start(ap, som);
|
|
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
|
pms_m[i_w].axe_w = va_arg(ap, c3_w);
|
|
pms_m[i_w].som = va_arg(ap, u2_noun);
|
|
}
|
|
va_end(ap);
|
|
}
|
|
|
|
/* Apply.
|
|
*/
|
|
return _molt_apply(wir_r, som, len_w, pms_m);
|
|
}
|
|
|
|
/* u2_bn_mp():
|
|
**
|
|
** Copy the GMP integer [a] into an atom.
|
|
*/
|
|
u2_noun
|
|
u2_bn_mp(u2_ray wir_r,
|
|
mpz_t a_mp)
|
|
{
|
|
return u2_bl_good(wir_r, u2_rl_mp(wir_r, a_mp));
|
|
}
|
|
|
|
/* u2_bn_nock():
|
|
**
|
|
** Nock or bail.
|
|
*/
|
|
u2_noun
|
|
u2_bn_nock(u2_ray wir_r, u2_noun bus, u2_noun fol)
|
|
{
|
|
u2_noun pro;
|
|
|
|
if ( (u2_none == bus) || (u2_none == fol) ) {
|
|
return u2_bl_bail(wir_r, c3__fail);
|
|
}
|
|
#if 1
|
|
pro = u2_nk_nock(wir_r, u2_rl_gain(wir_r, bus), fol);
|
|
|
|
if ( u2_none == pro ) {
|
|
return u2_bl_bail(wir_r, c3__exit);
|
|
}
|
|
else return pro;
|
|
#else
|
|
return u2_bl_good(wir_r, u2_nk_nock(wir_r, u2_rl_gain(wir_r, bus), fol));
|
|
#endif
|
|
}
|
|
|
|
/* u2_bn_mang():
|
|
**
|
|
** Kick a gate, substituting axes with nouns.
|
|
**
|
|
** Caller retains arguments; function transfers result.
|
|
*/
|
|
u2_noun
|
|
u2_bn_mang(u2_wire wir_r,
|
|
u2_noun gat,
|
|
...)
|
|
{
|
|
va_list vap;
|
|
u2_noun dur, pro;
|
|
|
|
va_start(vap, gat);
|
|
dur = u2_bn_molf(wir_r, gat, vap);
|
|
va_end(vap);
|
|
|
|
pro = u2_nk_nock(wir_r, dur, u2_t(dur));
|
|
|
|
return pro;
|
|
}
|
|
|
|
/* u2_bn_hook():
|
|
**
|
|
** Execute hook from core.
|
|
*/
|
|
u2_noun
|
|
u2_bn_hook(u2_wire wir_r,
|
|
u2_noun cor,
|
|
const c3_c* tam_c)
|
|
{
|
|
u2_weak vib = u2_ds_look(wir_r, cor, tam_c);
|
|
|
|
if ( u2_none == vib ) {
|
|
fprintf(stderr, "no hook: %s\n", tam_c);
|
|
c3_assert(0);
|
|
return u2_bl_bail(wir_r, c3__fail);
|
|
} else {
|
|
if ( u2_nul == u2_h(vib) ) {
|
|
u2_noun rag = u2_frag(u2_t(vib), cor);
|
|
|
|
// printf("%s %d\n", tam_c, u2_t(vib));
|
|
u2_rz(wir_r, vib);
|
|
|
|
return u2_rx(wir_r, rag);
|
|
}
|
|
else {
|
|
u2_noun ret = u2_bn_nock(wir_r, cor, vib);
|
|
|
|
u2_rz(wir_r, vib);
|
|
return ret;
|
|
}
|
|
}
|
|
}
|
|
|
|
/* u2_bn_cook():
|
|
**
|
|
** Reverse hook as molt.
|
|
*/
|
|
u2_noun // transfer
|
|
u2_bn_cook(u2_wire wir_r,
|
|
u2_noun cor, // retain
|
|
const c3_c* tam_c,
|
|
u2_noun som) // transfer
|
|
{
|
|
u2_weak vib = u2_ds_look(wir_r, cor, tam_c);
|
|
u2_noun axe;
|
|
|
|
if ( (u2_none == vib) ||
|
|
(u2_no == u2_dust(vib)) ||
|
|
(u2_nul != u2_h(vib)) ||
|
|
(u2_no == u2_stud(axe = u2_t(vib)) ) )
|
|
{
|
|
u2_rz(wir_r, vib);
|
|
|
|
return u2_bl_bail(wir_r, c3__fail);
|
|
} else {
|
|
u2_noun gon = u2_bn_molt(wir_r, cor, axe, som, 0);
|
|
|
|
u2_rz(wir_r, vib);
|
|
u2_rz(wir_r, som);
|
|
return gon;
|
|
}
|
|
}
|
|
|
|
/* u2_bn_mong():
|
|
**
|
|
** Call by gate and sample (new convention).
|
|
** Caller retains `gat`, transfers `sam`.
|
|
*/
|
|
u2_noun
|
|
u2_bn_mong(u2_wire wir_r,
|
|
u2_weak gat,
|
|
u2_weak sam)
|
|
{
|
|
u2_weak pro = u2_nk_mong(wir_r, gat, sam);
|
|
|
|
if ( u2_none == pro ) {
|
|
return u2_bl_bail(wir_r, c3__exit);
|
|
}
|
|
else return pro;
|
|
}
|
|
|
|
/* u2_bn_gort():
|
|
**
|
|
** Call by core, depth, hook, molt list.
|
|
*/
|
|
u2_noun
|
|
u2_bn_gort(u2_wire wir_r,
|
|
u2_noun cor,
|
|
const c3_c* tam_c,
|
|
...)
|
|
{
|
|
// XX: tested, but leaks. Check memory protocol.
|
|
//
|
|
u2_noun fol = u2_bl_good(wir_r, u2_ds_look(wir_r, cor, tam_c));
|
|
u2_noun gat = u2_bn_nock(wir_r, cor, fol);
|
|
u2_noun tec;
|
|
va_list vap;
|
|
|
|
va_start(vap, tam_c);
|
|
tec = u2_bn_molf(wir_r, gat, vap);
|
|
va_end(vap);
|
|
|
|
u2_rz(wir_r, fol);
|
|
return u2_bn_nock(wir_r, tec, u2_t(tec));
|
|
}
|
|
|
|
/* u2_bn_wait():
|
|
**
|
|
** Produce the functional equivalent of `|.(~(tam cor sam))`.
|
|
*/
|
|
u2_noun // produce
|
|
u2_bn_wait(u2_wire wir_r,
|
|
u2_noun cor, // retain
|
|
u2_noun sam, // retain
|
|
const c3_c* tam_c) // retain
|
|
{
|
|
c3_assert(!"not implemented"); return 0;
|
|
#if 0
|
|
u2_noun rac = u2_bn_molt(wir_r, cor, u2_cv_sam, sam, 0);
|
|
u2_noun rox = u2_ds_look(wir_r, rac, tam_c);
|
|
|
|
if ( u2_none == rox ) {
|
|
return u2_bl_bail(wir_r, c3__fail);
|
|
} else {
|
|
return u2_bc
|
|
(wir_r, rac,
|
|
u2_bt(wir_r,
|
|
u2_nock_flac,
|
|
u2_bc(wir_r, 0, 2),
|
|
rox));
|
|
}
|
|
#endif
|
|
}
|
|
|
|
/* u2_bn_qual():
|
|
**
|
|
** Produce the quadruple [a b c d].
|
|
*/
|
|
u2_noun
|
|
u2_bn_qual(u2_ray wir_r,
|
|
u2_noun a,
|
|
u2_noun b,
|
|
u2_noun c,
|
|
u2_noun d)
|
|
{
|
|
return u2_bl_good(wir_r, u2_rl_qual(wir_r, a, b, c, d));
|
|
}
|
|
|
|
/* u2_bn_quil():
|
|
**
|
|
** Produce the quintuple [a b c d].
|
|
*/
|
|
u2_noun
|
|
u2_bn_quil(u2_ray wir_r,
|
|
u2_noun a,
|
|
u2_noun b,
|
|
u2_noun c,
|
|
u2_noun d,
|
|
u2_noun e)
|
|
{
|
|
return u2_bn_cell(wir_r, a, u2_bn_qual(wir_r, b, c, d, e));
|
|
}
|
|
|
|
/* u2_bn_tape():
|
|
**
|
|
** Create an atomic string from a list of bytes.
|
|
*/
|
|
u2_noun
|
|
u2_bn_tape(u2_ray wir_r,
|
|
u2_list lit)
|
|
{
|
|
c3_w len_w = 0;
|
|
|
|
{
|
|
u2_noun ilt = lit;
|
|
|
|
while ( u2_nul != ilt ) { len_w++; ilt = u2_t(ilt); }
|
|
}
|
|
{
|
|
c3_w lat_w = 0;
|
|
c3_y buf_y[len_w];
|
|
|
|
while ( u2_nul != lit ) {
|
|
buf_y[lat_w++] = u2_bi_byte(wir_r, 0, u2_h(lit));
|
|
lit = u2_t(lit);
|
|
}
|
|
return u2_bn_bytes(wir_r, len_w, buf_y);
|
|
}
|
|
}
|
|
|
|
/* u2_bn_decimal():
|
|
**
|
|
** On (wir_r), write (list), a list of digits, as a decimal.
|
|
*/
|
|
u2_noun
|
|
u2_bn_decimal(u2_ray wir_r,
|
|
u2_list lit)
|
|
{
|
|
mpz_t mp;
|
|
|
|
mpz_init(mp);
|
|
while ( u2_nul != lit ) {
|
|
c3_w byt_w = u2_bi_byte(wir_r, 0, u2_h(lit));
|
|
|
|
mpz_mul_ui(mp, mp, 10);
|
|
mpz_add_ui(mp, mp, (byt_w - '0'));
|
|
|
|
lit = u2_t(lit);
|
|
}
|
|
return u2_bn_mp(wir_r, mp);
|
|
}
|
|
|
|
/* u2_bn_heximal():
|
|
**
|
|
** On (wir_r), write (lit), a list of digits, as a hexadecimal.
|
|
*/
|
|
u2_noun
|
|
u2_bn_heximal(u2_ray wir_r,
|
|
u2_list lit)
|
|
{
|
|
mpz_t mp;
|
|
|
|
mpz_init(mp);
|
|
while ( u2_nul != lit ) {
|
|
c3_w byt_w = u2_bi_byte(wir_r, 0, u2_h(lit));
|
|
|
|
mpz_mul_ui(mp, mp, 16);
|
|
if ( (byt_w >= 'a') && (byt_w <= 'f') ) {
|
|
mpz_add_ui(mp, mp, (byt_w + 10 - 'a'));
|
|
}
|
|
else {
|
|
mpz_add_ui(mp, mp, (byt_w - '0'));
|
|
}
|
|
lit = u2_t(lit);
|
|
}
|
|
return u2_bn_mp(wir_r, mp);
|
|
}
|
|
|
|
/* u2_bn_trel():
|
|
**
|
|
** Produce the triple [a b c].
|
|
*/
|
|
u2_noun
|
|
u2_bn_trel(u2_ray wir_r,
|
|
u2_noun a,
|
|
u2_noun b,
|
|
u2_noun c)
|
|
{
|
|
return u2_bl_good(wir_r, u2_rl_trel(wir_r, a, b, c));
|
|
}
|
|
|
|
/* u2_bn_words():
|
|
**
|
|
** Copy [a] words from [b] into an atom.
|
|
*/
|
|
u2_noun
|
|
u2_bn_words(u2_ray wir_r,
|
|
c3_w a_w,
|
|
const c3_w* b_w)
|
|
{
|
|
return u2_bl_good(wir_r, u2_rl_words(wir_r, a_w, b_w));
|
|
}
|
|
|
|
/* u2_bn_slab():
|
|
**
|
|
** Create an atomic slab of `len` words.
|
|
*/
|
|
u2_ray
|
|
u2_bn_slab(u2_wire wir_r,
|
|
c3_w len_w)
|
|
{
|
|
return u2_bl_some(wir_r, u2_rl_slab(wir_r, len_w));
|
|
}
|
|
|
|
/* u2_bn_slaq():
|
|
**
|
|
** Create an atomic slab of `len` bloqs of size `met`.
|
|
*/
|
|
u2_ray
|
|
u2_bn_slaq(u2_wire wir_r,
|
|
c3_g met_g,
|
|
c3_w len_w)
|
|
{
|
|
return u2_bn_slab(wir_r, ((len_w << met_g) + 31) >> 5);
|
|
}
|
|
|
|
/* u2_bi_cell():
|
|
**
|
|
** Factor `a` as a cell `[b c].
|
|
*/
|
|
void
|
|
u2_bi_cell(u2_wire wir_r,
|
|
u2_noun a,
|
|
u2_noun* b,
|
|
u2_noun* c)
|
|
{
|
|
if ( u2_no == u2_as_cell(a, b, c) ) {
|
|
u2_bl_bail(wir_r, c3__exit);
|
|
}
|
|
}
|
|
|
|
/* u2_bi_qual():
|
|
**
|
|
** Factor `a` as a quadruple `[b c d e]`.
|
|
*/
|
|
void
|
|
u2_bi_qual(u2_wire wir_r,
|
|
u2_noun a,
|
|
u2_noun* b,
|
|
u2_noun* c,
|
|
u2_noun* d,
|
|
u2_noun* e)
|
|
{
|
|
if ( u2_no == u2_as_qual(a, b, c, d, e) ) {
|
|
u2_bl_bail(wir_r, c3__exit);
|
|
}
|
|
}
|
|
|
|
/* u2_bi_quil():
|
|
**
|
|
** Factor `a` as a quintuple `[b c d e f]`, or bail.
|
|
*/
|
|
void
|
|
u2_bi_quil(u2_wire wir_r,
|
|
u2_noun a,
|
|
u2_noun* b,
|
|
u2_noun* c,
|
|
u2_noun* d,
|
|
u2_noun* e,
|
|
u2_noun* f)
|
|
{
|
|
if ( u2_no == u2_as_quil(a, b, c, d, e, f) ) {
|
|
u2_bl_bail(wir_r, c3__exit);
|
|
}
|
|
}
|
|
|
|
/* u2_bi_trel():
|
|
**
|
|
** Factor `a` as a trel `[b c d]`, or bail.
|
|
*/
|
|
void
|
|
u2_bi_trel(u2_wire wir_r,
|
|
u2_noun a,
|
|
u2_noun* b,
|
|
u2_noun* c,
|
|
u2_noun* d)
|
|
{
|
|
if ( u2_no == u2_as_trel(a, b, c, d) ) {
|
|
u2_bl_bail(wir_r, c3__exit);
|
|
}
|
|
}
|
|
|