shrub/n/i.c

399 lines
7.0 KiB
C
Raw Normal View History

2014-09-11 04:01:32 +04:00
/* g/i.c
2014-09-05 23:55:16 +04:00
**
** This file is in the public domain.
*/
#include "all.h"
2014-11-06 03:20:01 +03:00
/* u3i_words():
2014-09-05 23:55:16 +04:00
**
** Copy [a] words from [b] into an atom.
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_words(c3_w a_w,
2014-09-05 23:55:16 +04:00
const c3_w* b_w)
{
/* Strip trailing zeroes.
*/
while ( a_w && !b_w[a_w - 1] ) {
a_w--;
}
/* Check for cat.
*/
if ( !a_w ) {
return 0;
}
else if ( (a_w == 1) && !(b_w[0] >> 31) ) {
return b_w[0];
}
/* Allocate, fill, return.
*/
{
2014-11-06 03:20:01 +03:00
c3_w* nov_w = u3a_walloc(a_w + c3_wiseof(u3a_atom));
u3a_atom* nov_u = (void*)nov_w;
2014-09-05 23:55:16 +04:00
nov_u->mug_w = 0;
nov_u->len_w = a_w;
/* Fill the words.
*/
{
c3_w i_w;
for ( i_w=0; i_w < a_w; i_w++ ) {
nov_u->buf_w[i_w] = b_w[i_w];
}
}
2014-11-06 03:20:01 +03:00
return u3a_to_pug(u3a_outa(nov_w));
2014-09-05 23:55:16 +04:00
}
}
2014-11-06 03:20:01 +03:00
/* u3i_chubs():
2014-09-05 23:55:16 +04:00
**
** Construct `a` double-words from `b`, LSD first, as an atom.
*/
2014-09-06 00:13:24 +04:00
u3_atom
2014-11-06 03:20:01 +03:00
u3i_chubs(c3_w a_w,
2014-09-05 23:55:16 +04:00
const c3_d* b_d)
{
c3_w *b_w = c3_malloc(a_w * 8);
c3_w i_w;
2014-09-06 00:13:24 +04:00
u3_atom p;
2014-09-05 23:55:16 +04:00
for ( i_w = 0; i_w < a_w; i_w++ ) {
b_w[(2 * i_w)] = b_d[i_w] & 0xffffffffULL;
b_w[(2 * i_w) + 1] = b_d[i_w] >> 32ULL;
}
2014-11-06 03:20:01 +03:00
p = u3i_words((a_w * 2), b_w);
2014-09-05 23:55:16 +04:00
free(b_w);
return p;
}
2014-11-06 03:20:01 +03:00
/* u3i_bytes():
2014-09-05 23:55:16 +04:00
**
** Copy `a` bytes from `b` to an LSB first atom.
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_bytes(c3_w a_w,
2014-09-05 23:55:16 +04:00
const c3_y* b_y)
{
/* Strip trailing zeroes.
*/
while ( a_w && !b_y[a_w - 1] ) {
a_w--;
}
/* Check for cat.
*/
if ( a_w <= 4 ) {
if ( !a_w ) {
return 0;
}
else if ( a_w == 1 ) {
return b_y[0];
}
else if ( a_w == 2 ) {
return (b_y[0] | (b_y[1] << 8));
}
else if ( a_w == 3 ) {
return (b_y[0] | (b_y[1] << 8) | (b_y[2] << 16));
}
else if ( (b_y[3] <= 0x7f) ) {
return (b_y[0] | (b_y[1] << 8) | (b_y[2] << 16) | (b_y[3] << 24));
}
}
/* Allocate, fill, return.
*/
{
c3_w len_w = (a_w + 3) >> 2;
2014-11-06 03:20:01 +03:00
c3_w* nov_w = u3a_walloc((len_w + c3_wiseof(u3a_atom)));
u3a_atom* nov_u = (void*)nov_w;
2014-09-05 23:55:16 +04:00
nov_u->mug_w = 0;
nov_u->len_w = len_w;
/* Clear the words.
*/
{
c3_w i_w;
for ( i_w=0; i_w < len_w; i_w++ ) {
nov_u->buf_w[i_w] = 0;
}
}
/* Fill the bytes.
*/
{
c3_w i_w;
for ( i_w=0; i_w < a_w; i_w++ ) {
nov_u->buf_w[i_w >> 2] |= (b_y[i_w] << ((i_w & 3) * 8));
}
}
2014-11-06 03:20:01 +03:00
return u3a_to_pug(u3a_outa(nov_w));
2014-09-05 23:55:16 +04:00
}
}
2014-11-06 03:20:01 +03:00
/* u3i_mp():
2014-09-05 23:55:16 +04:00
**
** Copy the GMP integer `a` into an atom, and clear it.
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_mp(mpz_t a_mp)
2014-09-05 23:55:16 +04:00
{
/* Efficiency: unnecessary copy.
*/
{
c3_w pyg_w = mpz_size(a_mp) * ((sizeof(mp_limb_t)) / 4);
c3_w *buz_w = alloca(pyg_w * 4);
c3_w i_w;
for ( i_w = 0; i_w < pyg_w; i_w++ ) {
buz_w[i_w] = 0;
}
mpz_export(buz_w, 0, -1, 4, 0, 0, a_mp);
mpz_clear(a_mp);
2014-11-06 03:20:01 +03:00
return u3i_words(pyg_w, buz_w);
2014-09-05 23:55:16 +04:00
}
}
2014-11-06 03:20:01 +03:00
/* u3i_vint():
2014-09-05 23:55:16 +04:00
**
** Create `a + 1`.
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_vint(u3_noun a)
2014-09-05 23:55:16 +04:00
{
2014-11-06 02:36:30 +03:00
c3_assert(u3_none != a);
2014-09-05 23:55:16 +04:00
2014-11-06 03:20:01 +03:00
if ( _(u3a_is_cat(a)) ) {
2014-09-05 23:55:16 +04:00
c3_w vin_w = (a + 1);
if ( a == 0x7fffffff ) {
2014-11-06 03:20:01 +03:00
return u3i_words(1, &vin_w);
2014-09-05 23:55:16 +04:00
}
else return vin_w;
}
2014-11-06 03:20:01 +03:00
else if ( _(u3a_is_cell(a)) ) {
return u3m_bail(c3__exit);
2014-09-05 23:55:16 +04:00
}
else {
mpz_t a_mp;
2014-11-06 03:20:01 +03:00
u3r_mp(a_mp, a);
u3a_lose(a);
2014-09-05 23:55:16 +04:00
mpz_add_ui(a_mp, a_mp, 1);
2014-11-06 03:20:01 +03:00
return u3i_mp(a_mp);
2014-09-05 23:55:16 +04:00
}
}
2014-11-06 03:20:01 +03:00
/* u3i_cell():
2014-09-05 23:55:16 +04:00
**
** Produce the cell `[a b]`.
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_cell(u3_noun a, u3_noun b)
2014-09-05 23:55:16 +04:00
{
2014-11-06 02:36:30 +03:00
c3_assert(u3_none != a);
c3_assert(u3_none != b);
2014-09-05 23:55:16 +04:00
2014-11-06 03:20:01 +03:00
c3_assert(!_(u3a_is_junior(u3R, a)));
c3_assert(!_(u3a_is_junior(u3R, b)));
2014-09-05 23:55:16 +04:00
{
2014-11-06 03:20:01 +03:00
c3_w* nov_w = u3a_walloc(c3_wiseof(u3a_cell));
u3a_cell* nov_u = (void *)nov_w;
2014-10-28 20:36:22 +03:00
u3_noun pro;
2014-09-05 23:55:16 +04:00
nov_u->mug_w = 0;
nov_u->hed = a;
nov_u->tel = b;
2014-11-06 03:20:01 +03:00
pro = u3a_to_pom(u3a_outa(nov_w));
2014-10-28 20:36:22 +03:00
#if 0
2014-11-06 03:20:01 +03:00
if ( 0x15d47649 == u3r_mug(pro) ) {
2014-10-31 00:40:05 +03:00
fprintf(stderr, "BAD %x\r\n", pro);
BAD = pro;
2014-10-28 20:36:22 +03:00
}
#endif
2014-10-11 09:32:58 +04:00
#if 1
2014-10-28 20:36:22 +03:00
return pro;
2014-10-11 09:32:58 +04:00
#else
2014-11-06 03:20:01 +03:00
if ( !FOO ) return u3a_to_pom(u3a_outa(nov_w));
2014-10-10 05:27:02 +04:00
else {
2014-11-06 03:20:01 +03:00
u3_noun pro = u3a_to_pom(u3a_outa(nov_w));
2014-10-10 05:27:02 +04:00
2014-11-06 03:20:01 +03:00
u3m_p("leaked", pro);
printf("pro %u, %x\r\n", pro, u3r_mug(pro));
2014-10-10 05:27:02 +04:00
abort();
}
2014-10-11 09:32:58 +04:00
#endif
2014-09-05 23:55:16 +04:00
}
}
2014-11-06 03:20:01 +03:00
/* u3i_trel():
2014-09-05 23:55:16 +04:00
**
** Produce the triple `[a b c]`.
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_trel(u3_noun a, u3_noun b, u3_noun c)
2014-09-05 23:55:16 +04:00
{
2014-11-06 03:20:01 +03:00
return u3i_cell(a, u3i_cell(b, c));
2014-09-05 23:55:16 +04:00
}
2014-11-06 03:20:01 +03:00
/* u3i_qual():
2014-09-05 23:55:16 +04:00
**
** Produce the cell `[a b c d]`.
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_qual(u3_noun a, u3_noun b, u3_noun c, u3_noun d)
2014-09-05 23:55:16 +04:00
{
2014-11-06 03:20:01 +03:00
return u3i_cell(a, u3i_trel(b, c, d));
2014-09-05 23:55:16 +04:00
}
2014-11-06 03:20:01 +03:00
/* u3i_string():
2014-09-05 23:55:16 +04:00
**
** Produce an LSB-first atom from the C string `a`.
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_string(const c3_c* a_c)
2014-09-05 23:55:16 +04:00
{
2014-11-06 03:20:01 +03:00
return u3i_bytes(strlen(a_c), (c3_y *)a_c);
2014-09-05 23:55:16 +04:00
}
2014-11-06 03:20:01 +03:00
/* u3i_tape(): from a C string, to a list of bytes.
2014-09-05 23:55:16 +04:00
*/
2014-09-06 00:13:24 +04:00
u3_atom
2014-11-06 03:20:01 +03:00
u3i_tape(const c3_c* txt_c)
2014-09-05 23:55:16 +04:00
{
if ( !*txt_c ) {
2014-09-06 00:13:24 +04:00
return u3_nul;
2014-11-06 03:20:01 +03:00
} else return u3i_cell(*txt_c, u3i_tape(txt_c + 1));
2014-09-05 23:55:16 +04:00
}
2014-11-06 03:20:01 +03:00
/* u3i_decimal():
2014-09-05 23:55:16 +04:00
**
** Parse `a` as a list of decimal digits.
*/
2014-09-06 00:13:24 +04:00
u3_atom
2014-11-06 03:20:01 +03:00
u3i_decimal(u3_noun a);
2014-09-05 23:55:16 +04:00
2014-11-06 03:20:01 +03:00
/* u3i_heximal():
2014-09-05 23:55:16 +04:00
**
** Parse `a` as a list of hex digits.
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_heximal(u3_noun a);
2014-09-05 23:55:16 +04:00
2014-11-06 03:20:01 +03:00
/* u3i_list():
2014-09-05 23:55:16 +04:00
**
2014-11-06 02:36:30 +03:00
** Generate a null-terminated list, with `u3_none` as terminator.
2014-09-05 23:55:16 +04:00
*/
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_list(u3_weak one, ...);
2014-09-05 23:55:16 +04:00
2014-11-06 03:20:01 +03:00
/* u3i_molt():
2014-09-05 23:55:16 +04:00
**
** Mutate `som` with a 0-terminated list of axis, noun pairs.
** Axes must be cats (31 bit).
*/
struct _molt_pair {
c3_w axe_w;
2014-09-06 00:13:24 +04:00
u3_noun som;
2014-09-05 23:55:16 +04:00
};
static c3_w
_molt_cut(c3_w len_w,
struct _molt_pair* pms_m)
{
c3_w i_w, cut_t, cut_w;
2014-11-05 04:09:17 +03:00
cut_t = 0;
2014-09-05 23:55:16 +04:00
cut_w = 0;
for ( i_w = 0; i_w < len_w; i_w++ ) {
c3_w axe_w = pms_m[i_w].axe_w;
2014-11-18 00:56:51 +03:00
if ( (cut_t == 0) && (3 == u3x_cap(axe_w)) ) {
2014-11-05 04:09:17 +03:00
cut_t = 1;
2014-09-05 23:55:16 +04:00
cut_w = i_w;
}
2014-11-18 00:56:51 +03:00
pms_m[i_w].axe_w = u3x_mas(axe_w);
2014-09-05 23:55:16 +04:00
}
return cut_t ? cut_w : i_w;
}
2014-09-06 00:13:24 +04:00
static u3_noun // transfer
_molt_apply(u3_noun som, // retain
2014-09-05 23:55:16 +04:00
c3_w len_w,
struct _molt_pair* pms_m) // transfer
{
if ( len_w == 0 ) {
2014-11-06 03:20:01 +03:00
return u3a_gain(som);
2014-09-05 23:55:16 +04:00
}
else if ( (len_w == 1) && (1 == pms_m[0].axe_w) ) {
return pms_m[0].som;
}
else {
c3_w cut_w = _molt_cut(len_w, pms_m);
2014-11-06 03:20:01 +03:00
if ( c3n == u3a_is_cell(som) ) {
return u3m_bail(c3__exit);
2014-09-05 23:55:16 +04:00
}
else {
2014-11-06 03:20:01 +03:00
return u3i_cell
(_molt_apply(u3a_h(som), cut_w, pms_m),
_molt_apply(u3a_t(som), (len_w - cut_w), (pms_m + cut_w)));
2014-09-05 23:55:16 +04:00
}
}
}
2014-09-06 00:13:24 +04:00
u3_noun
2014-11-06 03:20:01 +03:00
u3i_molt(u3_noun som, ...)
2014-09-05 23:55:16 +04:00
{
va_list ap;
c3_w len_w;
struct _molt_pair* pms_m;
2014-09-06 00:13:24 +04:00
u3_noun pro;
2014-09-05 23:55:16 +04:00
/* Count.
*/
len_w = 0;
{
va_start(ap, som);
while ( 1 ) {
if ( 0 == va_arg(ap, c3_w) ) {
break;
}
2014-09-06 00:13:24 +04:00
va_arg(ap, u3_weak*);
2014-09-05 23:55:16 +04:00
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);
2014-09-06 00:13:24 +04:00
pms_m[i_w].som = va_arg(ap, u3_noun);
2014-09-05 23:55:16 +04:00
}
va_end(ap);
}
/* Apply.
*/
pro = _molt_apply(som, len_w, pms_m);
2014-11-06 03:20:01 +03:00
u3a_lose(som);
2014-09-05 23:55:16 +04:00
return pro;
}