/// @file #include "serial.h" #include #include #include "allocate.h" #include "hashtable.h" #include "jets/k.h" #include "jets/q.h" #include "retrieve.h" #include "serial.h" #include "ur/ur.h" #include "vortex.h" #include "xtract.h" const c3_y u3s_dit_y[64] = { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '-', '~' }; /* _cs_jam_buf: struct for tracking the fibonacci-allocated jam of a noun */ struct _cs_jam_fib { u3i_slab* sab_u; u3p(u3h_root) har_p; c3_w a_w; c3_w b_w; c3_w bit_w; }; /* _cs_jam_fib_grow(): reallocate buffer with fibonacci growth */ static inline void _cs_jam_fib_grow(struct _cs_jam_fib* fib_u, c3_w mor_w) { c3_w wan_w = fib_u->bit_w + mor_w; // check for c3_w overflow // if ( wan_w < mor_w ) { u3m_bail(c3__fail); return; } if ( wan_w > fib_u->a_w ) { c3_w c_w = 0; // fibonacci growth // while ( c_w < wan_w ) { c_w = fib_u->a_w + fib_u->b_w; fib_u->b_w = fib_u->a_w; fib_u->a_w = c_w; } u3i_slab_grow(fib_u->sab_u, 0, c_w); } } /* _cs_jam_fib_chop(): chop [met_w] bits of [a] into [fib_u] */ static inline void _cs_jam_fib_chop(struct _cs_jam_fib* fib_u, c3_w met_w, u3_noun a) { c3_w bit_w = fib_u->bit_w; _cs_jam_fib_grow(fib_u, met_w); fib_u->bit_w += met_w; { c3_w* buf_w = fib_u->sab_u->buf_w; u3r_chop(0, 0, met_w, bit_w, buf_w, a); } } /* _cs_jam_fib_mat(): length-prefixed encode (mat) [a] into [fib_u] */ static void _cs_jam_fib_mat(struct _cs_jam_fib* fib_u, u3_noun a) { if ( 0 == a ) { _cs_jam_fib_chop(fib_u, 1, 1); } else { c3_w a_w = u3r_met(0, a); c3_w b_w = c3_bits_word(a_w); c3_w bit_w = fib_u->bit_w; // amortize overflow checks and reallocation // { c3_w met_w = a_w + (2 * b_w); if ( a_w > (UINT32_MAX - 64) ) { u3m_bail(c3__fail); return; } _cs_jam_fib_grow(fib_u, met_w); fib_u->bit_w += met_w; } { c3_w src_w[2]; c3_w* buf_w = fib_u->sab_u->buf_w; // _cs_jam_fib_chop(fib_u, b_w+1, 1 << b_w); // { c3_d dat_d = (c3_d)1 << b_w; src_w[0] = (c3_w)dat_d; src_w[1] = dat_d >> 32; u3r_chop_words(0, 0, b_w + 1, bit_w, buf_w, 2, src_w); bit_w += b_w + 1; } // _cs_jam_fib_chop(fib_u, b_w-1, a_w); // { src_w[0] = a_w; u3r_chop_words(0, 0, b_w - 1, bit_w, buf_w, 1, src_w); bit_w += b_w - 1; } // _cs_jam_fib_chop(fib_u, a_w, a); // u3r_chop(0, 0, a_w, bit_w, buf_w, a); } } } /* _cs_jam_fib_atom_cb(): encode atom or backref */ static void _cs_jam_fib_atom_cb(u3_atom a, void* ptr_v) { struct _cs_jam_fib* fib_u = ptr_v; u3_weak b = u3h_git(fib_u->har_p, a); // if [a] has no backref, encode atom and put cursor into [har_p] // if ( u3_none == b ) { u3h_put(fib_u->har_p, a, u3i_words(1, &(fib_u->bit_w))); _cs_jam_fib_chop(fib_u, 1, 0); _cs_jam_fib_mat(fib_u, a); } else { c3_w a_w = u3r_met(0, a); c3_w b_w = u3r_met(0, b); // if [a] is smaller than the backref, encode atom // if ( a_w <= b_w ) { _cs_jam_fib_chop(fib_u, 1, 0); _cs_jam_fib_mat(fib_u, a); } // otherwise, encode backref // else { _cs_jam_fib_chop(fib_u, 2, 3); _cs_jam_fib_mat(fib_u, b); } } } /* _cs_jam_fib_cell_cb(): encode cell or backref */ static c3_o _cs_jam_fib_cell_cb(u3_noun a, void* ptr_v) { struct _cs_jam_fib* fib_u = ptr_v; u3_weak b = u3h_git(fib_u->har_p, a); // if [a] has no backref, encode cell and put cursor into [har_p] // if ( u3_none == b ) { u3h_put(fib_u->har_p, a, u3i_words(1, &(fib_u->bit_w))); _cs_jam_fib_chop(fib_u, 2, 1); return c3y; } // otherwise, encode backref and shortcircuit traversal // else { _cs_jam_fib_chop(fib_u, 2, 3); _cs_jam_fib_mat(fib_u, b); return c3n; } } /* u3s_jam_fib(): jam without atom allocation. ** ** returns atom-suitable words, and *bit_w will have ** the length (in bits). return should be freed with u3a_wfree(). */ c3_w u3s_jam_fib(u3i_slab* sab_u, u3_noun a) { struct _cs_jam_fib fib_u; fib_u.har_p = u3h_new(); fib_u.sab_u = sab_u; // fib(12) is small enough to be reasonably fast to allocate. // fib(11) is needed to get fib(13). // // fib_u.a_w = ur_fib12; fib_u.b_w = ur_fib11; fib_u.bit_w = 0; u3i_slab_init(sab_u, 0, fib_u.a_w); u3a_walk_fore(a, &fib_u, _cs_jam_fib_atom_cb, _cs_jam_fib_cell_cb); u3h_free(fib_u.har_p); return fib_u.bit_w; } typedef struct _jam_xeno_s { u3p(u3h_root) har_p; ur_bsw_t rit_u; } _jam_xeno_t; /* _cs_coin_chub(): shortcircuit u3i_chubs(). */ static inline u3_atom _cs_coin_chub(c3_d a_d) { return ( 0x7fffffffULL >= a_d ) ? a_d : u3i_chubs(1, &a_d); } /* _cs_jam_xeno_atom(): encode in/direct atom in bitstream. */ static inline void _cs_jam_bsw_atom(ur_bsw_t* rit_u, c3_w met_w, u3_atom a) { if ( c3y == u3a_is_cat(a) ) { // XX need a ur_bsw_atom32() // ur_bsw_atom64(rit_u, (c3_y)met_w, (c3_d)a); } else { u3a_atom* vat_u = u3a_to_ptr(a); // XX assumes little-endian // XX need a ur_bsw_atom_words() // c3_y* byt_y = (c3_y*)vat_u->buf_w; ur_bsw_atom_bytes(rit_u, (c3_d)met_w, byt_y); } } /* _cs_jam_bsw_back(): encode in/direct backref in bitstream. */ static inline void _cs_jam_bsw_back(ur_bsw_t* rit_u, c3_w met_w, u3_atom a) { c3_d bak_d = ( c3y == u3a_is_cat(a) ) ? (c3_d)a : u3r_chub(0, a); // XX need a ur_bsw_back32() // ur_bsw_back64(rit_u, (c3_y)met_w, bak_d); } /* _cs_jam_xeno_atom(): encode atom or backref in bitstream. */ static void _cs_jam_xeno_atom(u3_atom a, void* ptr_v) { _jam_xeno_t* jam_u = ptr_v; ur_bsw_t* rit_u = &(jam_u->rit_u); u3_weak bak = u3h_git(jam_u->har_p, a); c3_w met_w = u3r_met(0, a); if ( u3_none == bak ) { u3h_put(jam_u->har_p, a, _cs_coin_chub(rit_u->bits)); _cs_jam_bsw_atom(rit_u, met_w, a); } else { c3_w bak_w = u3r_met(0, bak); if ( met_w <= bak_w ) { _cs_jam_bsw_atom(rit_u, met_w, a); } else { _cs_jam_bsw_back(rit_u, bak_w, bak); } } } /* _cs_jam_xeno_cell(): encode cell or backref in bitstream. */ static c3_o _cs_jam_xeno_cell(u3_noun a, void* ptr_v) { _jam_xeno_t* jam_u = ptr_v; ur_bsw_t* rit_u = &(jam_u->rit_u); u3_weak bak = u3h_git(jam_u->har_p, a); if ( u3_none == bak ) { u3h_put(jam_u->har_p, a, _cs_coin_chub(rit_u->bits)); ur_bsw_cell(rit_u); return c3y; } else { _cs_jam_bsw_back(rit_u, u3r_met(0, bak), bak); return c3n; } } /* u3s_jam_xeno(): jam with off-loom buffer (re-)allocation. */ c3_d u3s_jam_xeno(u3_noun a, c3_d* len_d, c3_y** byt_y) { _jam_xeno_t jam_u = {0}; ur_bsw_init(&jam_u.rit_u, ur_fib11, ur_fib12); jam_u.har_p = u3h_new(); u3a_walk_fore(a, &jam_u, _cs_jam_xeno_atom, _cs_jam_xeno_cell); u3h_free(jam_u.har_p); return ur_bsw_done(&jam_u.rit_u, len_d, byt_y); } /* _cs_cue: stack frame for tracking intermediate cell results */ typedef struct _cs_cue { u3_weak hed; // head of a cell or u3_none u3_atom wid; // bitwidth of [hed] or 0 u3_atom cur; // bit-cursor position } _cs_cue; /* _cs_rub: rub, TRANSFER [cur], RETAIN [a] */ static inline u3_noun _cs_rub(u3_atom cur, u3_atom a) { u3_noun pro = u3qe_rub(cur, a); u3z(cur); return pro; } /* _cs_cue_next(): advance into [a], reading next value ** TRANSFER [cur], RETAIN [a] */ static inline u3_noun _cs_cue_next(u3a_pile* pil_u, u3p(u3h_root) har_p, u3_atom cur, u3_atom a, u3_atom* wid) { while ( 1 ) { // read tag bit at cur // c3_y tag_y = u3qc_cut(0, cur, 1, a); // low bit unset, (1 + cur) points to an atom // // produce atom and the width we read // if ( 0 == tag_y ) { u3_noun bur = _cs_rub(u3i_vint(cur), a); u3_noun pro = u3k(u3t(bur)); u3h_put(har_p, cur, u3k(pro)); *wid = u3qa_inc(u3h(bur)); u3z(bur); return pro; } else { // read tag bit at (1 + cur) // { u3_noun x = u3qa_inc(cur); tag_y = u3qc_cut(0, x, 1, a); u3z(x); } // next bit set, (2 + cur) points to a backref // // produce referenced value and the width we read // if ( 1 == tag_y ) { u3_noun bur = _cs_rub(u3ka_add(2, cur), a); u3_noun pro = u3x_good(u3h_get(har_p, u3t(bur))); *wid = u3qa_add(2, u3h(bur)); u3z(bur); return pro; } // next bit unset, (2 + cur) points to the head of a cell // // push a head-frame onto the road stack and read the head // else { _cs_cue* fam_u = u3a_push(pil_u); // NB: fam_u->wid unused in head-frame // fam_u->hed = u3_none; fam_u->cur = cur; cur = u3qa_add(2, cur); continue; } } } } u3_noun u3s_cue(u3_atom a) { // pro: cue'd noun product // wid: bitwidth read to produce [pro] // fam_u: stack frame // har_p: backreference table // pil_u: stack control structure // u3_noun pro; u3_atom wid; _cs_cue* fam_u; u3p(u3h_root) har_p = u3h_new(); u3a_pile pil_u; // initialize stack control // u3a_pile_prep(&pil_u, sizeof(*fam_u)); // commence cueing at bit-position 0 // pro = _cs_cue_next(&pil_u, har_p, 0, a, &wid); // process cell results // if ( c3n == u3a_pile_done(&pil_u) ) { fam_u = u3a_peek(&pil_u); do { // head-frame: stash [pro] and [wid]; continue into the tail // if ( u3_none == fam_u->hed ) { // NB: fam_u->wid unused in head-frame // fam_u->hed = pro; fam_u->wid = wid; // continue reading at the bit-position after [pro] { u3_noun cur = u3ka_add(2, u3qa_add(wid, fam_u->cur)); pro = _cs_cue_next(&pil_u, har_p, cur, a, &wid); } fam_u = u3a_peek(&pil_u); } // tail-frame: cons cell, recalculate [wid], and pop the stack // else { pro = u3nc(fam_u->hed, pro); u3h_put(har_p, fam_u->cur, u3k(pro)); u3z(fam_u->cur); wid = u3ka_add(2, u3ka_add(wid, fam_u->wid)); fam_u = u3a_pop(&pil_u); } } while ( c3n == u3a_pile_done(&pil_u) ); } u3z(wid); u3h_free(har_p); return pro; } /* ** stack frame for recording head vs tail iteration ** ** $? [u3_none bits=@] ** [hed=* bits=@] */ typedef struct _cue_frame_s { u3_weak ref; c3_d bit_d; } _cue_frame_t; /* _cs_cue_xeno_next(): read next value from bitstream, dictionary off-loom. */ static inline ur_cue_res_e _cs_cue_xeno_next(u3a_pile* pil_u, ur_bsr_t* red_u, ur_dict32_t* dic_u, u3_noun* out) { ur_root_t* rot_u = 0; while ( 1 ) { c3_d len_d, bit_d = red_u->bits; ur_cue_tag_e tag_e; ur_cue_res_e res_e; if ( ur_cue_good != (res_e = ur_bsr_tag(red_u, &tag_e)) ) { return res_e; } switch ( tag_e ) { default: u3_assert(0); case ur_jam_cell: { _cue_frame_t* fam_u = u3a_push(pil_u); fam_u->ref = u3_none; fam_u->bit_d = bit_d; continue; } case ur_jam_back: { if ( ur_cue_good != (res_e = ur_bsr_rub_len(red_u, &len_d)) ) { return res_e; } else if ( 62 < len_d ) { return ur_cue_meme; } else { c3_d bak_d = ur_bsr64_any(red_u, len_d); c3_w bak_w; if ( !ur_dict32_get(rot_u, dic_u, bak_d, &bak_w) ) { return ur_cue_back; } *out = u3k((u3_noun)bak_w); return ur_cue_good; } } case ur_jam_atom: { if ( ur_cue_good != (res_e = ur_bsr_rub_len(red_u, &len_d)) ) { return res_e; } if ( 31 >= len_d ) { *out = (u3_noun)ur_bsr32_any(red_u, len_d); } else { c3_d byt_d = (len_d + 0x7) >> 3; u3i_slab sab_u; if ( 0xffffffffULL < byt_d) { return ur_cue_meme; } else { u3i_slab_init(&sab_u, 3, byt_d); ur_bsr_bytes_any(red_u, len_d, sab_u.buf_y); *out = u3i_slab_mint_bytes(&sab_u); } } ur_dict32_put(rot_u, dic_u, bit_d, *out); return ur_cue_good; } } } } struct _u3_cue_xeno { ur_dict32_t dic_u; }; /* _cs_cue_xeno(): cue on-loom, with off-loom dictionary in handle. */ static u3_weak _cs_cue_xeno(u3_cue_xeno* sil_u, c3_d len_d, const c3_y* byt_y) { ur_bsr_t red_u = {0}; ur_dict32_t* dic_u = &sil_u->dic_u; u3a_pile pil_u; _cue_frame_t* fam_u; ur_cue_res_e res_e; u3_noun ref; // initialize stack control // u3a_pile_prep(&pil_u, sizeof(*fam_u)); // init bitstream-reader // if ( ur_cue_good != (res_e = ur_bsr_init(&red_u, len_d, byt_y)) ) { return c3n; } // bit-cursor (and backreferences) must fit in 62-bit direct atoms // else if ( 0x7ffffffffffffffULL < len_d ) { return c3n; } // advance into stream // res_e = _cs_cue_xeno_next(&pil_u, &red_u, dic_u, &ref); // process cell results // if ( (c3n == u3a_pile_done(&pil_u)) && (ur_cue_good == res_e) ) { fam_u = u3a_peek(&pil_u); do { // f is a head-frame; stash result and read the tail from the stream // if ( u3_none == fam_u->ref ) { fam_u->ref = ref; res_e = _cs_cue_xeno_next(&pil_u, &red_u, dic_u, &ref); fam_u = u3a_peek(&pil_u); } // f is a tail-frame; pop the stack and continue // else { ur_root_t* rot_u = 0; ref = u3nc(fam_u->ref, ref); ur_dict32_put(rot_u, dic_u, fam_u->bit_d, ref); fam_u = u3a_pop(&pil_u); } } while ( (c3n == u3a_pile_done(&pil_u)) && (ur_cue_good == res_e) ); } if ( ur_cue_good == res_e ) { return ref; } // on failure, unwind the stack and dispose of intermediate nouns // else if ( c3n == u3a_pile_done(&pil_u) ) { do { if ( u3_none != fam_u->ref ) { u3z(fam_u->ref); } fam_u = u3a_pop(&pil_u); } while ( c3n == u3a_pile_done(&pil_u) ); } return u3_none; } /* u3s_cue_xeno_init_with(): initialize a cue_xeno handle as specified. */ u3_cue_xeno* u3s_cue_xeno_init_with(c3_d pre_d, c3_d siz_d) { u3_cue_xeno* sil_u; sil_u = c3_calloc(sizeof(*sil_u)); ur_dict32_grow((ur_root_t*)0, &sil_u->dic_u, pre_d, siz_d); return sil_u; } /* u3s_cue_xeno_init(): initialize a cue_xeno handle. */ u3_cue_xeno* u3s_cue_xeno_init(void) { return u3s_cue_xeno_init_with(ur_fib10, ur_fib11); } /* u3s_cue_xeno_init(): cue on-loom, with off-loom dictionary in handle. */ u3_weak u3s_cue_xeno_with(u3_cue_xeno* sil_u, c3_d len_d, const c3_y* byt_y) { u3_weak som; u3_assert( &(u3H->rod_u) == u3R ); som = _cs_cue_xeno(sil_u, len_d, byt_y); ur_dict32_wipe(&sil_u->dic_u); return som; } /* u3s_cue_xeno_init(): dispose cue_xeno handle. */ void u3s_cue_xeno_done(u3_cue_xeno* sil_u) { ur_dict_free((ur_dict_t*)&sil_u->dic_u); c3_free(sil_u); } /* u3s_cue_xeno(): cue on-loom, with off-loom dictionary. */ u3_weak u3s_cue_xeno(c3_d len_d, const c3_y* byt_y) { u3_cue_xeno* sil_u; u3_weak som; u3_assert( &(u3H->rod_u) == u3R ); sil_u = u3s_cue_xeno_init(); som = _cs_cue_xeno(sil_u, len_d, byt_y); u3s_cue_xeno_done(sil_u); return som; } /* _cs_cue_need(): bail on ur_cue_* read failures. */ static inline void _cs_cue_need(ur_cue_res_e res_e) { if ( ur_cue_good == res_e ) { return; } else { c3_m mot_m = (ur_cue_meme == res_e) ? c3__meme : c3__exit; u3m_bail(mot_m); } } /* _cs_cue_get(): u3h_get wrapper handling allocation and refcounts. */ static inline u3_weak _cs_cue_get(u3p(u3h_root) har_p, c3_d key_d) { u3_atom key = _cs_coin_chub(key_d); u3_weak pro = u3h_get(har_p, key); u3z(key); return pro; } /* _cs_cue_put(): u3h_put wrapper handling allocation and refcounts. */ static inline u3_noun _cs_cue_put(u3p(u3h_root) har_p, c3_d key_d, u3_noun val) { u3_atom key = _cs_coin_chub(key_d); u3h_put(har_p, key, u3k(val)); u3z(key); return val; } /* _cs_cue_bytes_next(): read next value from bitstream. */ static inline u3_noun _cs_cue_bytes_next(u3a_pile* pil_u, u3p(u3h_root) har_p, ur_bsr_t* red_u) { while ( 1 ) { c3_d len_d, bit_d = red_u->bits; ur_cue_tag_e tag_e; _cs_cue_need(ur_bsr_tag(red_u, &tag_e)); switch ( tag_e ) { default: u3_assert(0); case ur_jam_cell: { _cue_frame_t* fam_u = u3a_push(pil_u); fam_u->ref = u3_none; fam_u->bit_d = bit_d; continue; } case ur_jam_back: { _cs_cue_need(ur_bsr_rub_len(red_u, &len_d)); if ( 62 < len_d ) { return u3m_bail(c3__meme); } else { c3_d bak_d = ur_bsr64_any(red_u, len_d); u3_weak bak = _cs_cue_get(har_p, bak_d); return u3x_good(bak); } } case ur_jam_atom: { u3_atom vat; _cs_cue_need(ur_bsr_rub_len(red_u, &len_d)); if ( 31 >= len_d ) { vat = (u3_noun)ur_bsr32_any(red_u, len_d); } else { u3i_slab sab_u; u3i_slab_init(&sab_u, 0, len_d); ur_bsr_bytes_any(red_u, len_d, sab_u.buf_y); vat = u3i_slab_mint_bytes(&sab_u); } return _cs_cue_put(har_p, bit_d, vat); } } } } /* u3s_cue_bytes(): cue bytes onto the loom. */ u3_noun u3s_cue_bytes(c3_d len_d, const c3_y* byt_y) { ur_bsr_t red_u = {0}; u3a_pile pil_u; _cue_frame_t* fam_u; u3p(u3h_root) har_p; u3_noun ref; // initialize stack control // u3a_pile_prep(&pil_u, sizeof(*fam_u)); // initialize a hash table for dereferencing backrefs // har_p = u3h_new(); // init bitstream-reader // _cs_cue_need(ur_bsr_init(&red_u, len_d, byt_y)); // bit-cursor (and backreferences) must fit in 62-bit direct atoms // if ( 0x7ffffffffffffffULL < len_d ) { return u3m_bail(c3__meme); } // advance into stream // ref = _cs_cue_bytes_next(&pil_u, har_p, &red_u); // process cell results // if ( c3n == u3a_pile_done(&pil_u) ) { fam_u = u3a_peek(&pil_u); do { // f is a head-frame; stash result and read the tail from the stream // if ( u3_none == fam_u->ref ) { fam_u->ref = ref; ref = _cs_cue_bytes_next(&pil_u, har_p, &red_u); fam_u = u3a_peek(&pil_u); } // f is a tail-frame; pop the stack and continue // else { ref = u3nc(fam_u->ref, ref); _cs_cue_put(har_p, fam_u->bit_d, ref); fam_u = u3a_pop(&pil_u); } } while ( c3n == u3a_pile_done(&pil_u) ); } u3h_free(har_p); return ref; } /* u3s_cue_atom(): cue atom. */ u3_noun u3s_cue_atom(u3_atom a) { c3_w len_w = u3r_met(3, a); c3_y* byt_y; // XX assumes little-endian // if ( c3y == u3a_is_cat(a) ) { byt_y = (c3_y*)&a; } else { u3a_atom* vat_u = u3a_to_ptr(a); byt_y = (c3_y*)vat_u->buf_w; } return u3s_cue_bytes((c3_d)len_w, byt_y); } /* _cs_etch_ud_size(): output length in @ud for given mpz_t. */ static inline size_t _cs_etch_ud_size(mpz_t a_mp) { size_t len_i = mpz_sizeinbase(a_mp, 10); return len_i + (len_i / 3); // separators } /* _cs_etch_ud_bytes(): atom to @ud impl. */ static size_t _cs_etch_ud_bytes(mpz_t a_mp, size_t len_i, c3_y* hun_y) { c3_y* buf_y = hun_y + (len_i - 1); mpz_t b_mp; c3_w b_w; mpz_init2(b_mp, 10); if ( !mpz_size(a_mp) ) { *buf_y-- = '0'; } else { while ( 1 ) { b_w = mpz_tdiv_qr_ui(a_mp, b_mp, a_mp, 1000); u3_assert( mpz_get_ui(b_mp) == b_w ); // XX if ( !mpz_size(a_mp) ) { while ( b_w ) { *buf_y-- = '0' + (b_w % 10); b_w /= 10; } break; } *buf_y-- = '0' + (b_w % 10); b_w /= 10; *buf_y-- = '0' + (b_w % 10); b_w /= 10; *buf_y-- = '0' + (b_w % 10); *buf_y-- = '.'; } } buf_y++; u3_assert( buf_y >= hun_y ); // XX // mpz_sizeinbase may overestimate by 1 // { size_t dif_i = buf_y - hun_y; if ( dif_i ) { len_i -= dif_i; memmove(hun_y, buf_y, len_i); memset(hun_y + len_i, 0, dif_i); } } mpz_clear(b_mp); return len_i; } /* u3s_etch_ud_smol(): c3_d to @ud ** ** =(26 (met 3 (scot %ud (dec (bex 64))))) */ c3_y* u3s_etch_ud_smol(c3_d a_d, c3_y hun_y[26]) { c3_y* buf_y = hun_y + 25; c3_w b_w; if ( !a_d ) { *buf_y-- = '0'; } else { while ( 1 ) { b_w = a_d % 1000; a_d /= 1000; if ( !a_d ) { while ( b_w ) { *buf_y-- = '0' + (b_w % 10); b_w /= 10; } break; } *buf_y-- = '0' + (b_w % 10); b_w /= 10; *buf_y-- = '0' + (b_w % 10); b_w /= 10; *buf_y-- = '0' + (b_w % 10); *buf_y-- = '.'; } } return buf_y + 1; } /* u3s_etch_ud(): atom to @ud. */ u3_atom u3s_etch_ud(u3_atom a) { c3_d a_d; if ( c3y == u3r_safe_chub(a, &a_d) ) { c3_y hun_y[26]; c3_y* buf_y = u3s_etch_ud_smol(a_d, hun_y); c3_w dif_w = (c3_p)buf_y - (c3_p)hun_y; return u3i_bytes(26 - dif_w, buf_y); } u3i_slab sab_u; size_t len_i; mpz_t a_mp; u3r_mp(a_mp, a); len_i = _cs_etch_ud_size(a_mp); u3i_slab_bare(&sab_u, 3, len_i); sab_u.buf_w[sab_u.len_w - 1] = 0; _cs_etch_ud_bytes(a_mp, len_i, sab_u.buf_y); mpz_clear(a_mp); return u3i_slab_mint_bytes(&sab_u); } /* u3s_etch_ud_c(): atom to @ud, as a malloc'd c string. */ size_t u3s_etch_ud_c(u3_atom a, c3_c** out_c) { c3_d a_d; size_t len_i; c3_y* buf_y; if ( c3y == u3r_safe_chub(a, &a_d) ) { c3_y hun_y[26]; buf_y = u3s_etch_ud_smol(a_d, hun_y); len_i = 26 - ((c3_p)buf_y - (c3_p)hun_y); *out_c = c3_malloc(len_i + 1); (*out_c)[len_i] = 0; memcpy(*out_c, buf_y, len_i); return len_i; } mpz_t a_mp; u3r_mp(a_mp, a); len_i = _cs_etch_ud_size(a_mp); buf_y = c3_malloc(len_i + 1); buf_y[len_i] = 0; len_i = _cs_etch_ud_bytes(a_mp, len_i, buf_y); mpz_clear(a_mp); *out_c = (c3_c*)buf_y; return len_i; } /* _cs_etch_ux_bytes(): atom to @ux impl. */ static void _cs_etch_ux_bytes(u3_atom a, c3_w len_w, c3_y* buf_y) { c3_w i_w; c3_s inp_s; for ( i_w = 0; i_w < len_w; i_w++ ) { inp_s = u3r_short(i_w, a); *buf_y-- = u3s_dit_y[(inp_s >> 0) & 0xf]; *buf_y-- = u3s_dit_y[(inp_s >> 4) & 0xf]; *buf_y-- = u3s_dit_y[(inp_s >> 8) & 0xf]; *buf_y-- = u3s_dit_y[(inp_s >> 12) & 0xf]; *buf_y-- = '.'; } inp_s = u3r_short(len_w, a); while ( inp_s ) { *buf_y-- = u3s_dit_y[inp_s & 0xf]; inp_s >>= 4; } *buf_y-- = 'x'; *buf_y = '0'; } /* u3s_etch_ux(): atom to @ux. */ u3_atom u3s_etch_ux(u3_atom a) { if ( u3_blip == a ) { return c3_s3('0', 'x', '0'); } c3_w sep_w = u3r_met(4, a) - 1; // number of separators c3_w las_w = u3r_met(2, u3r_short(sep_w, a)); // digits before separator c3_w len_w = 2 + las_w + (sep_w * 5); // output bytes u3i_slab sab_u; u3i_slab_bare(&sab_u, 3, len_w); sab_u.buf_w[sab_u.len_w - 1] = 0; _cs_etch_ux_bytes(a, sep_w, sab_u.buf_y + len_w - 1); return u3i_slab_moot_bytes(&sab_u); } /* u3s_etch_ux_c(): atom to @ux, as a malloc'd c string. */ size_t u3s_etch_ux_c(u3_atom a, c3_c** out_c) { if ( u3_blip == a ) { *out_c = strdup("0x0"); return 3; } c3_y* buf_y; c3_w sep_w = u3r_met(4, a) - 1; c3_w las_w = u3r_met(2, u3r_short(sep_w, a)); size_t len_i = 2 + las_w + (sep_w * 5); buf_y = c3_malloc(1 + len_i); buf_y[len_i] = 0; _cs_etch_ux_bytes(a, sep_w, buf_y + len_i - 1); *out_c = (c3_c*)buf_y; return len_i; } // uint div+ceil non-zero // #define _divc_nz(x, y) (((x) + ((y) - 1)) / (y)) /* _cs_etch_uv_size(): output length in @uv (and aligned bits). */ static inline size_t _cs_etch_uv_size(u3_atom a, c3_w* out_w) { c3_w met_w = u3r_met(0, a); c3_w sep_w = _divc_nz(met_w, 25) - 1; // number of separators c3_w max_w = sep_w * 25; c3_w end_w = 0; u3r_chop(0, max_w, 25, 0, &end_w, a); c3_w bit_w = c3_bits_word(end_w); c3_w las_w = _divc_nz(bit_w, 5); // digits before separator *out_w = max_w; return 2 + las_w + (sep_w * 6); } /* _cs_etch_uv_bytes(): atom to @uv impl. */ static void _cs_etch_uv_bytes(u3_atom a, c3_w max_w, c3_y* buf_y) { c3_w i_w; c3_w inp_w; for ( i_w = 0; i_w < max_w; i_w += 25 ) { inp_w = 0; u3r_chop(0, i_w, 25, 0, &inp_w, a); *buf_y-- = u3s_dit_y[(inp_w >> 0) & 0x1f]; *buf_y-- = u3s_dit_y[(inp_w >> 5) & 0x1f]; *buf_y-- = u3s_dit_y[(inp_w >> 10) & 0x1f]; *buf_y-- = u3s_dit_y[(inp_w >> 15) & 0x1f]; *buf_y-- = u3s_dit_y[(inp_w >> 20) & 0x1f]; *buf_y-- = '.'; } inp_w = 0; u3r_chop(0, max_w, 25, 0, &inp_w, a); while ( inp_w ) { *buf_y-- = u3s_dit_y[inp_w & 0x1f]; inp_w >>= 5; } *buf_y-- = 'v'; *buf_y = '0'; } /* u3s_etch_uv(): atom to @uv. */ u3_atom u3s_etch_uv(u3_atom a) { if ( u3_blip == a ) { return c3_s3('0', 'v', '0'); } u3i_slab sab_u; c3_w max_w; size_t len_i = _cs_etch_uv_size(a, &max_w); u3i_slab_bare(&sab_u, 3, len_i); sab_u.buf_w[sab_u.len_w - 1] = 0; _cs_etch_uv_bytes(a, max_w, sab_u.buf_y + len_i - 1); return u3i_slab_moot_bytes(&sab_u); } /* u3s_etch_uv_c(): atom to @uv, as a malloc'd c string. */ size_t u3s_etch_uv_c(u3_atom a, c3_c** out_c) { if ( u3_blip == a ) { *out_c = strdup("0v0"); return 3; } c3_y* buf_y; c3_w max_w; size_t len_i = _cs_etch_uv_size(a, &max_w); buf_y = c3_malloc(1 + len_i); buf_y[len_i] = 0; _cs_etch_uv_bytes(a, max_w, buf_y + len_i - 1); *out_c = (c3_c*)buf_y; return len_i; } /* _cs_etch_uw_size(): output length in @uw (and aligned bits). */ static inline size_t _cs_etch_uw_size(u3_atom a, c3_w* out_w) { c3_w met_w = u3r_met(0, a); c3_w sep_w = _divc_nz(met_w, 30) - 1; // number of separators c3_w max_w = sep_w * 30; c3_w end_w = 0; u3r_chop(0, max_w, 30, 0, &end_w, a); c3_w bit_w = c3_bits_word(end_w); c3_w las_w = _divc_nz(bit_w, 6); // digits before separator *out_w = max_w; return 2 + las_w + (sep_w * 6); } /* _cs_etch_uw_bytes(): atom to @uw impl. */ static void _cs_etch_uw_bytes(u3_atom a, c3_w max_w, c3_y* buf_y) { c3_w i_w; c3_w inp_w; for ( i_w = 0; i_w < max_w; i_w += 30 ) { inp_w = 0; u3r_chop(0, i_w, 30, 0, &inp_w, a); *buf_y-- = u3s_dit_y[(inp_w >> 0) & 0x3f]; *buf_y-- = u3s_dit_y[(inp_w >> 6) & 0x3f]; *buf_y-- = u3s_dit_y[(inp_w >> 12) & 0x3f]; *buf_y-- = u3s_dit_y[(inp_w >> 18) & 0x3f]; *buf_y-- = u3s_dit_y[(inp_w >> 24) & 0x3f]; *buf_y-- = '.'; } inp_w = 0; u3r_chop(0, max_w, 30, 0, &inp_w, a); while ( inp_w ) { *buf_y-- = u3s_dit_y[inp_w & 0x3f]; inp_w >>= 6; } *buf_y-- = 'w'; *buf_y = '0'; } /* u3s_etch_uw(): atom to @uw. */ u3_atom u3s_etch_uw(u3_atom a) { if ( u3_blip == a ) { return c3_s3('0', 'w', '0'); } u3i_slab sab_u; c3_w max_w; size_t len_i = _cs_etch_uw_size(a, &max_w); u3i_slab_bare(&sab_u, 3, len_i); sab_u.buf_w[sab_u.len_w - 1] = 0; _cs_etch_uw_bytes(a, max_w, sab_u.buf_y + len_i - 1); return u3i_slab_moot_bytes(&sab_u); } /* u3s_etch_uw_c(): atom to @uw, as a malloc'd c string. */ size_t u3s_etch_uw_c(u3_atom a, c3_c** out_c) { if ( u3_blip == a ) { *out_c = strdup("0w0"); return 3; } c3_y* buf_y; c3_w max_w; size_t len_i = _cs_etch_uw_size(a, &max_w); buf_y = c3_malloc(1 + len_i); buf_y[len_i] = 0; _cs_etch_uw_bytes(a, max_w, buf_y + len_i - 1); *out_c = (c3_c*)buf_y; return len_i; } #undef _divc_nz #define DIGIT(a) ( ((a) >= '0') && ((a) <= '9') ) #define BLOCK(a) ( ('.' == (a)[0]) \ && DIGIT(a[1]) \ && DIGIT(a[2]) \ && DIGIT(a[3]) ) /* u3s_sift_ud_bytes: parse @ud */ u3_weak u3s_sift_ud_bytes(c3_w len_w, c3_y* byt_y) { c3_y num_y = len_w % 4; // leading digits length c3_s val_s = 0; // leading digits value // +ape:ag: just 0 // if ( !len_w ) return u3_none; if ( '0' == *byt_y ) return ( 1 == len_w ) ? (u3_noun)0 : u3_none; // +ted:ab: leading nonzero (checked above), plus up to 2 digits // #define NEXT() do { \ if ( !DIGIT(*byt_y) ) return u3_none; \ val_s *= 10; \ val_s += *byt_y++ - '0'; \ } while (0) switch ( num_y ) { case 3: NEXT(); case 2: NEXT(); case 1: NEXT(); break; case 0: return u3_none; } #undef NEXT len_w -= num_y; // +tid:ab: dot-prefixed 3-digit blocks // // avoid gmp allocation if possible // - 19 decimal digits fit in 64 bits // - 18 digits is 24 bytes with separators // if ( ((1 == num_y) && (24 >= len_w)) || (20 >= len_w) ) { c3_d val_d = val_s; while ( len_w ) { if ( !BLOCK(byt_y) ) return u3_none; byt_y++; val_d *= 10; val_d += *byt_y++ - '0'; val_d *= 10; val_d += *byt_y++ - '0'; val_d *= 10; val_d += *byt_y++ - '0'; len_w -= 4; } return u3i_chub(val_d); } { // avoid gmp realloc if possible // mpz_t a_mp; { c3_d bit_d = (c3_d)(len_w / 4) * 10; mpz_init2(a_mp, (c3_w)c3_min(bit_d, UINT32_MAX)); mpz_set_ui(a_mp, val_s); } while ( len_w ) { if ( !BLOCK(byt_y) ) { mpz_clear(a_mp); return u3_none; } byt_y++; val_s = *byt_y++ - '0'; val_s *= 10; val_s += *byt_y++ - '0'; val_s *= 10; val_s += *byt_y++ - '0'; mpz_mul_ui(a_mp, a_mp, 1000); mpz_add_ui(a_mp, a_mp, val_s); len_w -= 4; } return u3i_mp(a_mp); } } #undef BLOCK #undef DIGIT /* u3s_sift_ud: parse @ud. */ u3_weak u3s_sift_ud(u3_atom a) { c3_w len_w = u3r_met(3, a); c3_y* byt_y; // XX assumes little-endian // if ( c3y == u3a_is_cat(a) ) { byt_y = (c3_y*)&a; } else { u3a_atom* vat_u = u3a_to_ptr(a); byt_y = (c3_y*)vat_u->buf_w; } return u3s_sift_ud_bytes(len_w, byt_y); }