diff options
Diffstat (limited to 'vere/pkg/noun/jets/e')
59 files changed, 13504 insertions, 0 deletions
diff --git a/vere/pkg/noun/jets/e/adler.c b/vere/pkg/noun/jets/e/adler.c new file mode 100644 index 0000000..d7e1211 --- /dev/null +++ b/vere/pkg/noun/jets/e/adler.c @@ -0,0 +1,127 @@ +#include <imprison.h> +#include <jets/k.h> +#include <log.h> +#include <nock.h> +#include <retrieve.h> +#include <types.h> +#include <xtract.h> + +static void _x_octs(u3_noun octs, u3_atom* p_octs, u3_atom* q_octs) { + + if (c3n == u3r_mean(octs, + 2, p_octs, + 3, q_octs, 0)){ + u3m_bail(c3__exit); + } + + if (c3n == u3a_is_atom(*p_octs) || + c3n == u3a_is_atom(*q_octs)) { + u3m_bail(c3__exit); + } +} + +static c3_o _x_octs_buffer(u3_atom* p_octs, u3_atom *q_octs, + c3_w* p_octs_w, c3_y** buf_y, + c3_w* len_w, c3_w* lead_w) +{ + if (c3n == u3r_safe_word(*p_octs, p_octs_w)) { + return c3n; + } + + *len_w = u3r_met(3, *q_octs); + + if (c3y == u3a_is_cat(*q_octs)) { + *buf_y = (c3_y*)q_octs; + } + else { + u3a_atom* ptr_a = u3a_to_ptr(*q_octs); + *buf_y = (c3_y*)ptr_a->buf_w; + } + + *lead_w = 0; + + if (*p_octs_w > *len_w) { + *lead_w = *p_octs_w - *len_w; + } + else { + *len_w = *p_octs_w; + } + + return c3y; +} + +#define BASE 65521 +#define NMAX 5552 + +u3_noun _qe_adler32(u3_noun octs) +{ + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w, len_w, lead_w; + c3_y *buf_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &buf_y, + &len_w, &lead_w)) { + return u3_none; + } + + c3_w adler_w, sum2_w; + + adler_w = 0x1; + sum2_w = 0x0; + + c3_w pos_w = 0; + + // Process all non-zero bytes + // + while (pos_w < len_w) { + + c3_w rem_w = (len_w - pos_w); + + if (rem_w > NMAX) { + rem_w = NMAX; + } + + while (rem_w--) { + adler_w += *(buf_y + pos_w++); + sum2_w += adler_w; + } + + adler_w %= BASE; + sum2_w %= BASE; + } + + // Process leading zeros + // + while (pos_w < p_octs_w) { + + c3_w rem_w = (p_octs_w - pos_w); + + if (rem_w > NMAX) { + rem_w = NMAX; + } + + // leading zeros: adler sum is unchanged + sum2_w += rem_w*adler_w; + pos_w += rem_w; + + adler_w %= BASE; + sum2_w %= BASE; + } + + return u3i_word(sum2_w << 16 | adler_w); +} + + +u3_noun +u3we_adler32(u3_noun cor) +{ + u3_noun octs; + + u3x_mean(cor, u3x_sam, &octs, 0); + + return _qe_adler32(octs); +} diff --git a/vere/pkg/noun/jets/e/aes_cbc.c b/vere/pkg/noun/jets/e/aes_cbc.c new file mode 100644 index 0000000..f5369e0 --- /dev/null +++ b/vere/pkg/noun/jets/e/aes_cbc.c @@ -0,0 +1,182 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + +/* All of the CBC hoon truncates its key and prv inputs by passing them to + * the ECB functions, which truncate them, hence the raw u3r_bytes unpacking. + */ + +typedef int (*urcrypt_cbc)(c3_y**, + size_t*, + c3_y*, + c3_y*, + urcrypt_realloc_t); + + static u3_atom + _cqea_cbc_help(c3_y* key_y, u3_atom iv, u3_atom msg, urcrypt_cbc low_f) + { + u3_atom ret; + c3_w met_w; + c3_y iv_y[16]; + c3_y* msg_y = u3r_bytes_all(&met_w, msg); + size_t len = met_w; + + u3r_bytes(0, 16, iv_y, iv); + if ( 0 != (*low_f)(&msg_y, &len, key_y, iv_y, &u3a_realloc) ) { + ret = u3_none; + } + else { + ret = u3i_bytes(len, msg_y); + } + u3a_free(msg_y); + + return ret; + } + + static u3_atom + _cqea_cbca_en(u3_atom key, + u3_atom iv, + u3_atom msg) + { + c3_y key_y[16]; + u3r_bytes(0, 16, key_y, key); + return _cqea_cbc_help(key_y, iv, msg, &urcrypt_aes_cbca_en); + } + + u3_noun + u3wea_cbca_en(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam, &c, 60, &a, 61, &b, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("cbca-en", _cqea_cbca_en(a, b, c)); + } + } + + static u3_atom + _cqea_cbca_de(u3_atom key, + u3_atom iv, + u3_atom msg) + { + c3_y key_y[16]; + u3r_bytes(0, 16, key_y, key); + return _cqea_cbc_help(key_y, iv, msg, &urcrypt_aes_cbca_de); + } + + u3_noun + u3wea_cbca_de(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam, &c, 60, &a, 61, &b, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("cbca-de", _cqea_cbca_de(a, b, c)); + } + } + + static u3_atom + _cqea_cbcb_en(u3_atom key, + u3_atom iv, + u3_atom msg) + { + c3_y key_y[24]; + u3r_bytes(0, 24, key_y, key); + return _cqea_cbc_help(key_y, iv, msg, &urcrypt_aes_cbcb_en); + } + + u3_noun + u3wea_cbcb_en(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam, &c, 60, &a, 61, &b, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("cbcb-en", _cqea_cbcb_en(a, b, c)); + } + } + + static u3_atom + _cqea_cbcb_de(u3_atom key, + u3_atom iv, + u3_atom msg) + { + c3_y key_y[24]; + u3r_bytes(0, 24, key_y, key); + return _cqea_cbc_help(key_y, iv, msg, &urcrypt_aes_cbcb_de); + } + + u3_noun + u3wea_cbcb_de(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam, &c, 60, &a, 61, &b, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("cbcb-de", _cqea_cbcb_de(a, b, c)); + } + } + + static u3_atom + _cqea_cbcc_en(u3_atom key, + u3_atom iv, + u3_atom msg) + { + c3_y key_y[32]; + u3r_bytes(0, 32, key_y, key); + return _cqea_cbc_help(key_y, iv, msg, &urcrypt_aes_cbcc_en); + } + + u3_noun + u3wea_cbcc_en(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam, &c, 60, &a, 61, &b, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("cbcc-en", _cqea_cbcc_en(a, b, c)); + } + } + + static u3_atom + _cqea_cbcc_de(u3_atom key, + u3_atom iv, + u3_atom msg) + { + c3_y key_y[32]; + u3r_bytes(0, 32, key_y, key); + return _cqea_cbc_help(key_y, iv, msg, &urcrypt_aes_cbcc_de); + } + + u3_noun + u3wea_cbcc_de(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam, &c, 60, &a, 61, &b, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("cbcc-de", _cqea_cbcc_de(a, b, c)); + } + } diff --git a/vere/pkg/noun/jets/e/aes_ecb.c b/vere/pkg/noun/jets/e/aes_ecb.c new file mode 100644 index 0000000..eff536d --- /dev/null +++ b/vere/pkg/noun/jets/e/aes_ecb.c @@ -0,0 +1,166 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + +typedef int (*urcrypt_ecb)(c3_y*, c3_y[16], c3_y[16]); + + + /* All of the ECB hoon truncates its key and blk inputs with +fe, in these + * jets we unpack with an unconditional u3r_bytes */ + + static u3_atom + _cqea_ecb_help(c3_y* key_y, u3_atom blk, urcrypt_ecb low_f) + { + c3_y blk_y[16], out_y[16]; + + u3r_bytes(0, 16, blk_y, blk); + + if ( 0 != (*low_f)(key_y, blk_y, out_y) ) { + return u3_none; + } + else { + return u3i_bytes(16, out_y); + } + } + + static u3_atom + _cqea_ecba_en(u3_atom key, + u3_atom blk) + { + c3_y key_y[16]; + u3r_bytes(0, 16, key_y, key); + return _cqea_ecb_help(key_y, blk, &urcrypt_aes_ecba_en); + } + + u3_noun + u3wea_ecba_en(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam, &b, u3x_con_sam, &a, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("ecba-en", _cqea_ecba_en(a, b)); + } + } + + static u3_atom + _cqea_ecba_de(u3_atom key, + u3_atom blk) + { + c3_y key_y[16]; + u3r_bytes(0, 16, key_y, key); + return _cqea_ecb_help(key_y, blk, &urcrypt_aes_ecba_de); + } + + u3_noun + u3wea_ecba_de(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam, &b, u3x_con_sam, &a, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("ecba-de", _cqea_ecba_de(a, b)); + } + } + + static u3_atom + _cqea_ecbb_en(u3_atom key, + u3_atom blk) + { + c3_y key_y[24]; + u3r_bytes(0, 24, key_y, key); + return _cqea_ecb_help(key_y, blk, &urcrypt_aes_ecbb_en); + } + + u3_noun + u3wea_ecbb_en(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam, &b, u3x_con_sam, &a, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("ecbb-en", _cqea_ecbb_en(a, b)); + } + } + + static u3_atom + _cqea_ecbb_de(u3_atom key, + u3_atom blk) + { + c3_y key_y[24]; + u3r_bytes(0, 24, key_y, key); + return _cqea_ecb_help(key_y, blk, &urcrypt_aes_ecbb_de); + } + + u3_noun + u3wea_ecbb_de(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam, &b, u3x_con_sam, &a, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("ecbb-de", _cqea_ecbb_de(a, b)); + } + } + + static u3_atom + _cqea_ecbc_en(u3_atom key, + u3_atom blk) + { + c3_y key_y[32]; + u3r_bytes(0, 32, key_y, key); + return _cqea_ecb_help(key_y, blk, &urcrypt_aes_ecbc_en); + } + + u3_noun + u3wea_ecbc_en(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam, &b, u3x_con_sam, &a, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("ecbc-en", _cqea_ecbc_en(a, b)); + } + } + + static u3_atom + _cqea_ecbc_de(u3_atom key, + u3_atom blk) + { + c3_y key_y[32]; + u3r_bytes(0, 32, key_y, key); + return _cqea_ecb_help(key_y, blk, &urcrypt_aes_ecbc_de); + } + + u3_noun + u3wea_ecbc_de(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam, &b, u3x_con_sam, &a, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("ecbc-de", _cqea_ecbc_de(a, b)); + } + } diff --git a/vere/pkg/noun/jets/e/aes_siv.c b/vere/pkg/noun/jets/e/aes_siv.c new file mode 100644 index 0000000..f88ba6a --- /dev/null +++ b/vere/pkg/noun/jets/e/aes_siv.c @@ -0,0 +1,370 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + +typedef int (*urcrypt_siv)(c3_y*, size_t, + urcrypt_aes_siv_data*, size_t, + c3_y*, c3_y[16], c3_y*); + + +// soc_w = number of items +// mat_w = size in bytes of assoc array +// dat_w = size of allocation (array + atom storage) +static void +_cqea_measure_ads(u3_noun ads, c3_w* soc_w, c3_w *mat_w, c3_w *dat_w) +{ + u3_noun i, t; + c3_w a_w, b_w, tmp_w; + + for ( a_w = b_w = 0, t = ads; u3_nul != t; ++a_w ) { + u3x_cell(t, &i, &t); + if ( c3n == u3ud(i) ) { + u3m_bail(c3__exit); + return; + } + else { + tmp_w = b_w; + b_w += u3r_met(3, i); + if ( b_w < tmp_w ) { + u3m_bail(c3__fail); + return; + } + } + } + + // check for size overflows + tmp_w = a_w * sizeof(urcrypt_aes_siv_data); + if ( (tmp_w / a_w) != sizeof(urcrypt_aes_siv_data) ) { + u3m_bail(c3__fail); + } + else if ( (*dat_w = tmp_w + b_w) < tmp_w ) { + u3m_bail(c3__fail); + } + else { + *soc_w = a_w; + *mat_w = tmp_w; + } +} + +// assumes ads is a valid (list @) because it's already been measured +static void +_cqea_encode_ads(u3_noun ads, + c3_w mat_w, + urcrypt_aes_siv_data *dat_u) +{ + c3_w met_w; + u3_noun i, t; + urcrypt_aes_siv_data *cur_u; + c3_y *dat_y = ((c3_y*) dat_u) + mat_w; + + for ( cur_u = dat_u, t = ads; u3_nul != t; t = u3t(t), ++cur_u ) { + i = u3h(t); + met_w = u3r_met(3, i); + u3r_bytes(0, met_w, dat_y, i); + cur_u->length = met_w; + cur_u->bytes = dat_y; + dat_y += met_w; + } +} + +static void +_cqea_ads_free(urcrypt_aes_siv_data *dat_u) +{ + if ( NULL != dat_u ) { + u3a_free(dat_u); + } +} + +static urcrypt_aes_siv_data* +_cqea_ads_alloc(u3_noun ads, c3_w *soc_w) +{ + if ( !ads ) { + *soc_w = 0; + return NULL; + } + else { + c3_w mat_w, dat_w; + urcrypt_aes_siv_data *dat_u; + + _cqea_measure_ads(ads, soc_w, &mat_w, &dat_w); + dat_u = u3a_malloc(dat_w); + _cqea_encode_ads(ads, mat_w, dat_u); + return dat_u; + } +} + +static u3_noun +_cqea_siv_en(c3_y* key_y, + c3_w key_w, + u3_noun ads, + u3_atom txt, + urcrypt_siv low_f) +{ + u3_noun ret; + c3_w txt_w, soc_w; + c3_y *txt_y, *out_y, iv_y[16]; + urcrypt_aes_siv_data *dat_u; + + dat_u = _cqea_ads_alloc(ads, &soc_w); + txt_y = u3r_bytes_all(&txt_w, txt); + out_y = u3a_malloc(txt_w); + + ret = ( 0 != (*low_f)(txt_y, txt_w, dat_u, soc_w, key_y, iv_y, out_y) ) + ? u3_none + : u3nt(u3i_bytes(16, iv_y), + u3i_words(1, &txt_w), + u3i_bytes(txt_w, out_y)); + + u3a_free(txt_y); + u3a_free(out_y); + _cqea_ads_free(dat_u); + return ret; +} + +static u3_noun +_cqea_siv_de(c3_y* key_y, + c3_w key_w, + u3_noun ads, + u3_atom iv, + u3_atom len, + u3_atom txt, + urcrypt_siv low_f) +{ + c3_w txt_w; + if ( !u3r_word_fit(&txt_w, len) ) { + return u3m_bail(c3__fail); + } + else { + u3_noun ret; + c3_w soc_w; + c3_y *txt_y, *out_y, iv_y[16]; + urcrypt_aes_siv_data *dat_u; + + u3r_bytes(0, 16, iv_y, iv); + dat_u = _cqea_ads_alloc(ads, &soc_w); + txt_y = u3r_bytes_alloc(0, txt_w, txt); + out_y = u3a_malloc(txt_w); + + if ( 0 != (*low_f)(txt_y, txt_w, dat_u, soc_w, key_y, iv_y, out_y) ) { + return u3m_bail(c3__evil); + } + + ret = u3nc(0, u3i_bytes(txt_w, out_y)); + + u3a_free(txt_y); + u3a_free(out_y); + _cqea_ads_free(dat_u); + + return ret; + } +} + +// the siv* hoon doesn't explicitly check keysizes, but all of these functions +// have fixed maximum keysizes, so we will punt if we get a key that is too +// large. + +static u3_noun +_cqea_siva_en(u3_atom key, + u3_noun ads, + u3_atom txt) +{ + if ( u3r_met(3, key) > 32 ) { + return u3_none; + } + else { + c3_y key_y[32]; + u3r_bytes(0, 32, key_y, key); + return _cqea_siv_en(key_y, 32, ads, txt, &urcrypt_aes_siva_en); + } +} + +u3_noun +u3wea_siva_en(u3_noun cor) +{ + u3_noun key, ads, txt; + + if ( c3n == u3r_mean(cor, u3x_sam, &txt, + u3x_con_sam_2, &key, + u3x_con_sam_3, &ads, 0) || + c3n == u3ud(key) || + c3n == u3ud(txt) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("siva-en", _cqea_siva_en(key, ads, txt)); + } +} + +static u3_noun +_cqea_siva_de(u3_atom key, + u3_noun ads, + u3_atom iv, + u3_atom len, + u3_atom txt) +{ + if ( u3r_met(3, key) > 32 ) { + return u3_none; + } + else { + c3_y key_y[32]; + u3r_bytes(0, 32, key_y, key); + return _cqea_siv_de(key_y, 32, ads, iv, len, txt, &urcrypt_aes_siva_de); + } +} + +u3_noun +u3wea_siva_de(u3_noun cor) +{ + u3_noun key, ads, iv, len, txt; + + if ( c3n == u3r_mean(cor, + u3x_sam_2, &iv, + u3x_sam_6, &len, + u3x_sam_7, &txt, + u3x_con_sam_2, &key, + u3x_con_sam_3, &ads, 0) || + c3n == u3ud(key) || + c3n == u3ud(txt) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("siva-de", _cqea_siva_de(key, ads, iv, len, txt)); + } +} + +static u3_noun +_cqea_sivb_en(u3_atom key, + u3_noun ads, + u3_atom txt) +{ + if ( u3r_met(3, key) > 48 ) { + return u3_none; + } + else { + c3_y key_y[48]; + u3r_bytes(0, 48, key_y, key); + return _cqea_siv_en(key_y, 48, ads, txt, &urcrypt_aes_sivb_en); + } +} + + +u3_noun +u3wea_sivb_en(u3_noun cor) +{ + u3_noun key, ads, txt; + + if ( c3n == u3r_mean(cor, u3x_sam, &txt, + u3x_con_sam_2, &key, + u3x_con_sam_3, &ads, 0) || + c3n == u3ud(key) || + c3n == u3ud(txt) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("sivb-en", _cqea_sivb_en(key, ads, txt)); + } +} + +static u3_noun +_cqea_sivb_de(u3_atom key, + u3_noun ads, + u3_atom iv, + u3_atom len, + u3_atom txt) +{ + if ( u3r_met(3, key) > 48 ) { + return u3_none; + } + else { + c3_y key_y[48]; + u3r_bytes(0, 48, key_y, key); + return _cqea_siv_de(key_y, 48, ads, iv, len, txt, &urcrypt_aes_sivb_de); + } +} + +u3_noun +u3wea_sivb_de(u3_noun cor) +{ + u3_noun key, ads, iv, len, txt; + + if ( c3n == u3r_mean(cor, + u3x_sam_2, &iv, + u3x_sam_6, &len, + u3x_sam_7, &txt, + u3x_con_sam_2, &key, + u3x_con_sam_3, &ads, 0) || + c3n == u3ud(key) || + c3n == u3ud(txt) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("sivb-de", _cqea_sivb_de(key, ads, iv, len, txt)); + } +} + +static u3_noun +_cqea_sivc_en(u3_atom key, + u3_noun ads, + u3_atom txt) +{ + if ( u3r_met(3, key) > 64 ) { + return u3_none; + } + else { + c3_y key_y[64]; + u3r_bytes(0, 64, key_y, key); + return _cqea_siv_en(key_y, 64, ads, txt, &urcrypt_aes_sivc_en); + } +} + +u3_noun +u3wea_sivc_en(u3_noun cor) +{ + u3_noun key, ads, txt; + + if ( c3n == u3r_mean(cor, u3x_sam, &txt, + u3x_con_sam_2, &key, + u3x_con_sam_3, &ads, 0) || + c3n == u3ud(key) || + c3n == u3ud(txt) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("sivc-en", _cqea_sivc_en(key, ads, txt)); + } +} + +static u3_noun +_cqea_sivc_de(u3_atom key, + u3_noun ads, + u3_atom iv, + u3_atom len, + u3_atom txt) +{ + if ( u3r_met(3, key) > 64 ) { + return u3_none; + } + else { + c3_y key_y[64]; + u3r_bytes(0, 64, key_y, key); + return _cqea_siv_de(key_y, 64, ads, iv, len, txt, &urcrypt_aes_sivc_de); + } +} + +u3_noun +u3wea_sivc_de(u3_noun cor) +{ + u3_noun key, ads, iv, len, txt; + + if ( c3n == u3r_mean(cor, + u3x_sam_2, &iv, + u3x_sam_6, &len, + u3x_sam_7, &txt, + u3x_con_sam_2, &key, + u3x_con_sam_3, &ads, 0) || + c3n == u3ud(key) || + c3n == u3ud(txt) ) { + return u3m_bail(c3__exit); + } else { + return u3l_punt("sivc-de", _cqea_sivc_de(key, ads, iv, len, txt)); + } +} diff --git a/vere/pkg/noun/jets/e/argon2.c b/vere/pkg/noun/jets/e/argon2.c new file mode 100644 index 0000000..e52d42c --- /dev/null +++ b/vere/pkg/noun/jets/e/argon2.c @@ -0,0 +1,151 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + +/* helpers +*/ + + static int + argon2_alloc(uint8_t** output, size_t bytes) + { + *output = u3a_malloc(bytes); + return 1; + } + + static void + argon2_free(uint8_t* memory, size_t bytes) + { + u3a_free(memory); + } + + static c3_t + _cqear_unpack_type(c3_y* out, u3_atom in) + { + switch ( in ) { + default: + return 0; + case c3__d: + *out = urcrypt_argon2_d; + return 1; + case c3__i: + *out = urcrypt_argon2_i; + return 1; + case c3__id: + *out = urcrypt_argon2_id; + return 1; + case c3__u: + *out = urcrypt_argon2_u; + return 1; + } + } + + + static u3_atom + _cqe_argon2( // configuration params, + u3_atom out, u3_atom type, u3_atom version, + u3_atom threads, u3_atom mem_cost, u3_atom time_cost, + u3_atom wik, u3_atom key, u3_atom wix, u3_atom extra, + // input params + u3_atom wid, u3_atom dat, u3_atom wis, u3_atom sat ) + { + c3_y typ_u; + c3_w out_w, wik_w, wix_w, wid_w, wis_w, ver_w, ted_w, mem_w, tim_w; + + if ( !(u3r_word_fit(&out_w, out) && + u3r_word_fit(&wik_w, wik) && + u3r_word_fit(&wix_w, wix) && + u3r_word_fit(&wid_w, wid) && + u3r_word_fit(&wis_w, wis)) ) { + // too big to allocate + return u3m_bail(c3__fail); + } + else if ( !(_cqear_unpack_type(&typ_u, type) && + u3r_word_fit(&ver_w, version) && + u3r_word_fit(&ted_w, threads) && + u3r_word_fit(&mem_w, mem_cost) && + u3r_word_fit(&tim_w, time_cost)) ) { + return u3_none; + } + else { + u3_atom ret; + c3_y *key_y = u3r_bytes_alloc(0, wik_w, key), + *ex_y = u3r_bytes_alloc(0, wix_w, extra), + *dat_y = u3r_bytes_alloc(0, wid_w, dat), + *sat_y = u3r_bytes_alloc(0, wis_w, sat), + *out_y = u3a_malloc(out_w); + + const c3_c* err_c = urcrypt_argon2( + typ_u, ver_w, ted_w, mem_w, tim_w, + wik_w, key_y, + wix_w, ex_y, + wid_w, dat_y, + wis_w, sat_y, + out_w, out_y, + &argon2_alloc, + &argon2_free); + + u3a_free(key_y); + u3a_free(ex_y); + u3a_free(dat_y); + u3a_free(sat_y); + + if ( NULL == err_c ) { + ret = u3i_bytes(out_w, out_y); + } + else { + ret = u3_none; + u3l_log("argon2-error: %s", err_c); + } + + u3a_free(out_y); + return ret; + } + } + + u3_noun + u3we_argon2(u3_noun cor) + { + u3_noun // configuration params + out, type, version, + threads, mem_cost, time_cost, + wik, key, wix, extra, + // input params + wid, dat, wis, sat, + // for use during unpacking + wmsg, wsat, arg, brg, wkey, wext; + + // the hoon code for argon2 takes configuration parameters, + // and then produces a gate. we jet that inner gate. + // this does mean that the config params have gotten buried + // pretty deep in the subject, hence the +510. + if ( c3n == u3r_mean(cor, u3x_sam_2, &wmsg, + u3x_sam_3, &wsat, + 510, &arg, 0) || + u3r_cell(wmsg, &wid, &dat) || u3ud(wid) || u3ud(dat) || + u3r_cell(wsat, &wis, &sat) || u3ud(wis) || u3ud(sat) || + // + u3r_qual(arg, &out, &type, &version, &brg) || + u3ud(out) || u3ud(type) || u3ud(version) || + // + u3r_qual(brg, &threads, &mem_cost, &time_cost, &arg) || + u3ud(threads) || u3ud(mem_cost) || u3ud(time_cost) || + // + u3r_cell(arg, &wkey, &wext) || + u3r_cell(wkey, &wik, &key) || u3ud(wik) || u3ud(key) || + u3r_cell(wext, &wix, &extra) || u3ud(wix) || u3ud(extra) + ) + { + return u3m_bail(c3__exit); + } + else { + return u3l_punt("argon2", + _cqe_argon2(out, type, version, + threads, mem_cost, time_cost, + wik, key, wix, extra, + wid, dat, wis, sat)); + } + } diff --git a/vere/pkg/noun/jets/e/base.c b/vere/pkg/noun/jets/e/base.c new file mode 100644 index 0000000..8bbc761 --- /dev/null +++ b/vere/pkg/noun/jets/e/base.c @@ -0,0 +1,152 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qe_en_base16(u3_atom len, u3_atom dat) +{ + if ( c3n == u3a_is_cat(len) ) { + return u3m_bail(c3__fail); + } + else { + c3_w len_w = (c3_w)len; + u3i_slab sab_u; + + u3i_slab_bare(&sab_u, 4, len_w); + sab_u.buf_w[sab_u.len_w - 1] = 0; + + { + c3_y* buf_y = sab_u.buf_y; + c3_y inp_y; + + while ( len_w-- ) { + inp_y = u3r_byte(len_w, dat); + + *buf_y++ = u3s_dit_y[inp_y >> 4]; + *buf_y++ = u3s_dit_y[inp_y & 0xf]; + } + } + + return u3i_slab_moot_bytes(&sab_u); + } +} + +static inline c3_o +_of_hex_digit(c3_y inp_y, c3_y* out_y) +{ + if ( inp_y >= '0' && inp_y <= '9' ) { + *out_y = inp_y - '0'; + return c3y; + } + else if ( inp_y >= 'a' && inp_y <= 'f' ) { + *out_y = inp_y - 87; + return c3y; + } + else if ( inp_y >= 'A' && inp_y <= 'F' ) { + *out_y = inp_y - 55; + return c3y; + } + + return c3n; +} + +static inline c3_o +_of_hex_odd(u3_atom inp, c3_w len_w, c3_w byt_w, c3_y* buf_y) +{ + c3_y low_y, hig_y, lit_y, hit_y; + + hig_y = u3r_byte(--byt_w, inp); + + while ( --len_w ) { + low_y = u3r_byte(--byt_w, inp); + + if ( (c3n == _of_hex_digit(low_y, &lit_y)) + || (c3n == _of_hex_digit(hig_y, &hit_y)) ) + { + return c3n; + } + else { + *buf_y++ = (hit_y & 0xf) ^ (lit_y << 4); + } + + hig_y = u3r_byte(--byt_w, inp); + } + + if ( c3n == _of_hex_digit(hig_y, &hit_y) ) { + return c3n; + } + else { + *buf_y = hit_y & 0xf; + } + + return c3y; +} + +static inline c3_o +_of_hex_even(u3_atom inp, c3_w len_w, c3_y* buf_y) +{ + c3_y lit_y, hit_y; + c3_s inp_s; + + while ( len_w-- ) { + inp_s = u3r_short(len_w, inp); + + if ( (c3n == _of_hex_digit(inp_s & 0xff, &lit_y)) + || (c3n == _of_hex_digit(inp_s >> 8, &hit_y)) ) + { + return c3n; + } + else { + *buf_y++ = (hit_y & 0xf) ^ (lit_y << 4); + } + } + + return c3y; +} + +u3_noun +u3qe_de_base16(u3_atom inp) +{ + c3_w len_w = u3r_met(4, inp); + u3i_slab sab_u; + + u3i_slab_bare(&sab_u, 3, len_w); + sab_u.buf_w[sab_u.len_w - 1] = 0; + + // even byte-length input can be parsed in aligned, 16-bit increments, + // but odd byte-length input cannot, and is expressed more simply in bytes. + // + { + c3_w byt_w = u3r_met(3, inp); + c3_o ret_o = ( byt_w & 1 ) + ? _of_hex_odd(inp, len_w, byt_w, sab_u.buf_y) + : _of_hex_even(inp, len_w, sab_u.buf_y); + + if ( c3n == ret_o ) { + u3i_slab_free(&sab_u); + return u3_nul; + } + else { + u3_noun dat = u3i_slab_mint_bytes(&sab_u); + return u3nt(u3_nul, u3i_word(len_w), dat); + } + } +} + +u3_noun +u3we_en_base16(u3_noun cor) +{ + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qe_en_base16(u3x_atom(a), u3x_atom(b)); +} + +u3_noun +u3we_de_base16(u3_noun cor) +{ + u3_noun sam = u3x_at(u3x_sam, cor); + return u3qe_de_base16(u3x_atom(sam)); +} diff --git a/vere/pkg/noun/jets/e/blake.c b/vere/pkg/noun/jets/e/blake.c new file mode 100644 index 0000000..cac4c48 --- /dev/null +++ b/vere/pkg/noun/jets/e/blake.c @@ -0,0 +1,163 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqe_blake2b(u3_atom wid, u3_atom dat, + u3_atom wik, u3_atom dak, + u3_atom out) + { + c3_w wid_w; + if ( !u3r_word_fit(&wid_w, wid) ) { + // impossible to represent an atom this large + return u3m_bail(c3__fail); + } + else { + // the hoon adjusts these widths to its liking + int err; + c3_y out_y[64], dak_y[64]; + c3_w wik_w = c3_min(wik, 64), + out_w = c3_max(1, c3_min(out, 64)); + c3_y *dat_y = u3r_bytes_alloc(0, wid_w, dat); + + u3r_bytes(0, wik_w, dak_y, dak); + err = urcrypt_blake2(wid_w, dat_y, wik_w, dak_y, out_w, out_y); + u3a_free(dat_y); + + if ( 0 == err ) { + return u3i_bytes(out_w, out_y); + } + else { + return u3_none; + } + } + } + + u3_noun + u3we_blake2b(u3_noun cor) + { + u3_noun msg, key, out, // arguments + wid, dat, // destructured msg + wik, dak; // destructured key + + if ( c3n == u3r_mean(cor, u3x_sam_2, &msg, + u3x_sam_6, &key, + u3x_sam_7, &out, 0) || + u3r_cell(msg, &wid, &dat) || u3ud(wid) || u3ud(dat) || + u3r_cell(key, &wik, &dak) || u3ud(wik) || u3ud(dak) || + u3ud(out) ) + { + return u3m_bail(c3__exit); + } else { + return u3l_punt("blake2b", _cqe_blake2b(wid, dat, wik, dak, out)); + } + } + + static u3_atom + _cqe_blake3_hash(u3_atom wid, u3_atom dat, + u3_atom key, u3_atom flags, u3_atom out) + { + c3_w wid_w, out_w; + if ( !u3r_word_fit(&wid_w, wid) || !u3r_word_fit(&out_w, out) ) { + return u3m_bail(c3__fail); + } + else { + c3_y key_y[32]; + u3r_bytes(0, 32, key_y, key); + c3_y flags_y = u3r_byte(0, flags); + c3_y *dat_y = u3r_bytes_alloc(0, wid_w, dat); + u3i_slab sab_u; + u3i_slab_bare(&sab_u, 3, out_w); + c3_y* out_y = sab_u.buf_y; + urcrypt_blake3_hash(wid_w, dat_y, key_y, flags_y, out, out_y); + u3a_free(dat_y); + return u3i_slab_mint(&sab_u); + } + } + + u3_noun + u3we_blake3_hash(u3_noun cor) + { + u3_noun out, msg, // arguments + wid, dat, // destructured msg + sam, key, flags; // context + + if ( c3n == u3r_mean(cor, u3x_sam_2, &out, + u3x_sam_3, &msg, + u3x_con_sam, &sam, 0) || + u3ud(out) || + u3r_cell(msg, &wid, &dat) || u3ud(wid) || u3ud(dat) || + u3r_cell(sam, &key, &flags) || u3ud(key) || u3ud(flags) ) + { + return u3m_bail(c3__exit); + } else { + return u3l_punt("blake3_hash", _cqe_blake3_hash(wid, dat, key, flags, out)); + } + } + + static u3_noun + _cqe_blake3_chunk_output(u3_atom wid, u3_atom dat, u3_atom cv, u3_atom counter, u3_atom flags) + { + c3_w wid_w; + if ( !u3r_word_fit(&wid_w, wid) ) { + return u3m_bail(c3__fail); + } else { + c3_y cv_y[32], block_y[64], block_len; + c3_y *dat_y = u3r_bytes_alloc(0, wid_w, dat); + c3_d counter_d = u3r_chub(0, counter); + c3_y flags_y = u3r_byte(0, flags); + u3r_bytes(0, 32, cv_y, cv); + urcrypt_blake3_chunk_output(wid_w, dat_y, cv_y, block_y, &block_len, &counter_d, &flags_y); + return u3i_cell(u3i_bytes(32, cv_y), u3i_qual(u3k(counter), u3i_bytes(64, block_y), block_len, flags_y)); + } + } + + u3_noun + u3we_blake3_chunk_output(u3_noun cor) + { + u3_noun counter, msg, // arguments + wid, dat, // destructured msg + key, flags; // context + + if ( c3n == u3r_mean(cor, u3x_sam_2, &counter, + u3x_sam_3, &msg, + u3x_con_sam_2, &key, + u3x_con_sam_3, &flags, 0) || + u3r_cell(msg, &wid, &dat) || u3ud(wid) || u3ud(dat) || + u3ud(key) || u3ud(flags)) + { + return u3m_bail(c3__exit); + } else { + return u3l_punt("blake3_chunk_output", _cqe_blake3_chunk_output(wid, dat, key, counter, flags)); + } + } + + static u3_atom + _cqe_blake3_compress(u3_atom cv, u3_atom counter, + u3_atom block, u3_atom block_len, u3_atom flags) + { + c3_y cv_y[32], block_y[64], out_y[64]; + u3r_bytes(0, 32, cv_y, cv); + u3r_bytes(0, 64, block_y, block); + urcrypt_blake3_compress(cv_y, block_y, block_len, counter, flags, out_y); + return u3i_bytes(64, out_y); + } + + u3_noun + u3we_blake3_compress(u3_noun cor) + { + u3_noun output = u3x_at(u3x_sam, cor); + u3_noun cv, counter, block, block_len, flags; // destructured output + + if ( u3r_quil(output, &cv, &counter, &block, &block_len, &flags) || + u3ud(cv) || u3ud(block) || u3ud(block_len) || u3ud(counter) || u3ud(flags)) + { + return u3m_bail(c3__exit); + } else { + return u3l_punt("blake3_compress", _cqe_blake3_compress(cv, counter, block, block_len, flags)); + } + } diff --git a/vere/pkg/noun/jets/e/bytestream.c b/vere/pkg/noun/jets/e/bytestream.c new file mode 100644 index 0000000..71761e1 --- /dev/null +++ b/vere/pkg/noun/jets/e/bytestream.c @@ -0,0 +1,1247 @@ +#include <types.h> +#include <imprison.h> +#include <jets/k.h> +#include <nock.h> +#include <retrieve.h> +#include <xtract.h> +#include <log.h> + +// XX do not crash on indirect atoms, but default to Hoon +// XX use u3i_word to imprison all indirect atoms +// +static void +_x_octs(u3_noun octs, u3_atom* p_octs, u3_atom* q_octs) { + + if (c3n == u3r_mean(octs, + 2, p_octs, + 3, q_octs, 0)){ + u3m_bail(c3__exit); + } + + if (c3n == u3a_is_atom(*p_octs) || + c3n == u3a_is_atom(*q_octs)) { + u3m_bail(c3__exit); + } +} +static c3_o +_x_octs_buffer(u3_atom* p_octs, u3_atom *q_octs, + c3_w* p_octs_w, c3_y** buf_y, + c3_w* len_w, c3_w* lead_w) +{ + if (c3n == u3r_safe_word(*p_octs, p_octs_w)) { + return c3n; + } + + *len_w = u3r_met(3, *q_octs); + + if (c3y == u3a_is_cat(*q_octs)) { + *buf_y = (c3_y*)q_octs; + } + else { + u3a_atom* ptr_a = u3a_to_ptr(*q_octs); + *buf_y = (c3_y*)ptr_a->buf_w; + } + + *lead_w = 0; + + if (*p_octs_w > *len_w) { + *lead_w = *p_octs_w - *len_w; + } + else { + *len_w = *p_octs_w; + } + + return c3y; +} + +u3_noun +_qe_bytestream_rip_octs(u3_atom p_octs, u3_atom q_octs) { + + c3_w p_octs_w, len_w, lead_w; + c3_y* buf_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &buf_y, + &len_w, &lead_w)){ + return u3_none; + } + + if (p_octs_w == 0) { + return u3_nul; + } + + u3_noun rip = u3_nul; + + while (lead_w--) { + rip = u3nc(0x0, rip); + } + + buf_y += len_w - 1; + + while (len_w--) { + rip = u3nc(*(buf_y--), rip); + } + + return rip; +} + +u3_noun +u3we_bytestream_rip_octs(u3_noun cor){ + + u3_noun sam = u3x_at(u3x_sam, cor); + + u3_atom p_octs, q_octs; + _x_octs(sam, &p_octs, &q_octs); + + return _qe_bytestream_rip_octs(p_octs, q_octs); + +} + +u3_noun +_qe_bytestream_cat_octs(u3_noun octs_a, u3_noun octs_b) { + + u3_atom p_octs_a, p_octs_b; + u3_atom q_octs_a, q_octs_b; + + _x_octs(octs_a, &p_octs_a, &q_octs_a); + _x_octs(octs_b, &p_octs_b, &q_octs_b); + + c3_w p_octs_a_w, p_octs_b_w; + c3_w len_w, lem_w; + c3_w lead_w, leaf_w; + + c3_y* sea_y; + c3_y* seb_y; + + if (c3n == _x_octs_buffer(&p_octs_a, &q_octs_a, + &p_octs_a_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + if (c3n == _x_octs_buffer(&p_octs_b, &q_octs_b, + &p_octs_b_w, &seb_y, + &lem_w, &leaf_w)) { + return u3_none; + } + + if (p_octs_a_w == 0) { + return u3k(octs_b); + } + + if (p_octs_b_w == 0) { + return u3k(octs_a); + } + + c3_d p_octs_d = p_octs_a_w + p_octs_b_w; + + u3_noun ret; + + // Both a and b are 0. + // + if (len_w == 0 && lem_w == 0) { + ret = u3nc(u3i_chub(p_octs_d), u3i_word(0)); + } + else { + u3i_slab sab_u; + + u3i_slab_bare(&sab_u, 3, (c3_d)p_octs_a_w + lem_w); + sab_u.buf_w[sab_u.len_w - 1] = 0; + + memcpy(sab_u.buf_y, sea_y, len_w); + memset(sab_u.buf_y + len_w, 0, lead_w); + memcpy(sab_u.buf_y + p_octs_a_w, seb_y, lem_w); + + u3_noun q_octs = u3i_slab_moot(&sab_u); + ret = u3nc(u3i_chub(p_octs_d), q_octs); + } + return ret; +} + +u3_noun +u3we_bytestream_cat_octs(u3_noun cor) { + + u3_noun octs_a, octs_b; + + u3x_mean(cor, u3x_sam_2, &octs_a, u3x_sam_3, &octs_b, 0); + + return _qe_bytestream_cat_octs(octs_a, octs_b); + +} + +u3_noun +_qe_bytestream_can_octs(u3_noun octs_list) { + + if (u3_nul == octs_list) { + return u3nc(0, 0); + } + + if (u3_nul == u3t(octs_list)) { + return u3k(u3h(octs_list)); + } + + /* We can octs in two steps: + * first loop iteration computes the total required + * buffer size in bytes, factoring in the leading bytes + * of the final octs. The second loop iterates over each octs, + * copying the data to the output buffer. + */ + + // Compute total size + // + c3_d tot_d = 0; + + u3_noun octs_list_start = octs_list; + u3_noun octs = u3_none; + // Last non-zero octs + u3_noun last_octs = u3_none; + + while (octs_list != u3_nul) { + + octs = u3h(octs_list); + + if (c3n == u3a_is_atom(u3h(octs)) || + c3n == u3a_is_atom(u3t(octs))) { + u3m_bail(c3__exit); + } + c3_w p_octs_w; + + if (c3n == u3r_safe_word(u3h(octs), &p_octs_w)) { + u3z(octs_list); + return u3_none; + } + // Check for overflow + // + if ( p_octs_w > (UINT64_MAX - tot_d)){ + return u3_none; + } + tot_d += p_octs_w; + + octs_list = u3t(octs_list); + } + + // Compute leading zeros of last non-zero octs -- the buffer + // size is decreased by this much. + // + // =leading-zeros (sub p.octs (met 3 q.octs)) + // + // p.octs fits into a word -- this has been verified + // in the loop above. + // + // The resulting buf_len_w is correct only if the last + // octs is non-zero: but at the return u3i_slab_mint + // takes care of trimming. + // + c3_w last_lead_w = (u3r_word(0, u3h(octs)) - u3r_met(3, u3t(octs))); + c3_d buf_len_w = tot_d - last_lead_w; + + if (buf_len_w == 0) { + return u3nc(u3i_word(tot_d), 0); + } + + u3i_slab sab_u; + u3i_slab_bare(&sab_u, 3, buf_len_w); + c3_y* buf_y = sab_u.buf_y; + + sab_u.buf_w[sab_u.len_w - 1] = 0; + + c3_y* sea_y; + u3_atom p_octs, q_octs; + c3_w p_octs_w, q_octs_w; + c3_w len_w, lead_w; + + // Bytes written so far + // + c3_d wit_d = 0; + + octs_list = octs_list_start; + + while (octs_list != u3_nul) { + + octs = u3h(octs_list); + + _x_octs(octs, &p_octs, &q_octs); + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)){ + return u3_none; + } + + if (p_octs_w == 0) { + octs_list = u3t(octs_list); + continue; + } + + memcpy(buf_y, sea_y, len_w); + buf_y += len_w; + wit_d += len_w; + + // More bytes to follow, write leading zeros + // + if (wit_d < buf_len_w) { + memset(buf_y, 0, lead_w); + buf_y += lead_w; + wit_d += lead_w; + } + + octs_list = u3t(octs_list); + } + + u3_assert((buf_y - sab_u.buf_y) == buf_len_w); + + return u3nc(u3i_chub(tot_d), u3i_slab_mint(&sab_u)); +} + +u3_noun +u3we_bytestream_can_octs(u3_noun cor) +{ + u3_noun octs_list; + + u3x_mean(cor, u3x_sam_1, &octs_list, 0); + + return _qe_bytestream_can_octs(octs_list); +} +u3_noun +_qe_bytestream_skip_line(u3_atom pos, u3_noun octs) +{ + c3_w pos_w; + + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w; + c3_w len_w, lead_w; + + c3_y* sea_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + while (pos_w < len_w) { + if (*(sea_y + pos_w) == '\n') { + break; + } + pos_w++; + } + // Newline not found, position at the end + if (*(sea_y + pos_w) != '\n') { + pos_w = p_octs; + } + else { + pos_w++; + } + + return u3nc(u3i_word(pos_w), u3k(octs)); +} +u3_noun +u3we_bytestream_skip_line(u3_noun cor) +{ + + u3_atom pos; + u3_noun octs; + + u3x_mean(cor, u3x_sam_2, &pos, u3x_sam_3, &octs, 0); + + return _qe_bytestream_skip_line(pos, octs); + +} +u3_noun +_qe_bytestream_find_byte(u3_atom bat, u3_atom pos, u3_noun octs) +{ + c3_w bat_w, pos_w; + + if (c3n == u3r_safe_word(bat, &bat_w) || bat_w > 0xff) { + return u3_none; + } + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w; + c3_w len_w, lead_w; + + c3_y* sea_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + while (pos_w < len_w) { + + if (*(sea_y + pos_w) == bat_w) { + return u3nc(u3_nul, u3i_word(pos_w)); + } + + pos_w++; + } + // Here we are sure that: + // (1) bat_w has not been found + // (2) therefore pos_w == len_w + // + // If bat_w == 0, and there is still input + // in the stream, it means pos_w points at + // the first leading zero. + // + if (pos_w < p_octs && bat_w == 0) { + return u3nc(u3_nul, u3i_word(pos_w)); + } + + return u3_nul; +} +u3_noun +u3we_bytestream_find_byte(u3_noun cor) +{ + u3_atom bat; + u3_atom pos; + u3_noun octs; + + u3x_mean(cor, u3x_sam_2, &bat, + u3x_sam_6, &pos, + u3x_sam_7, &octs, 0); + + return _qe_bytestream_find_byte(bat, pos, octs); +} +u3_noun +_qe_bytestream_seek_byte(u3_atom bat, u3_atom pos, u3_noun octs) +{ + c3_w bat_w, pos_w; + + if (c3n == u3r_safe_word(bat, &bat_w) || bat_w > 0xff) { + return u3_none; + } + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w; + c3_w len_w, lead_w; + + c3_y* sea_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + while (pos_w < len_w) { + + if (*(sea_y + pos_w) == bat_w) { + u3_noun idx = u3nc(u3_nul, u3i_word(pos_w)); + u3_noun new_bays = u3nc(u3i_word(pos_w), u3k(octs)); + return u3nc(idx, new_bays); + } + + pos_w++; + } + + // find leading zero: see comment in *_find_byte + // + if (pos_w < p_octs && bat_w == 0) { + u3_noun idx = u3nc(u3_nul, u3i_word(pos_w)); + u3_noun new_bays = u3nc(u3i_word(pos_w), u3k(octs)); + return u3nc(idx, new_bays); + } + + return u3nc(u3_nul, u3nc(u3k(pos), u3k(octs))); + +} +u3_noun +u3we_bytestream_seek_byte(u3_noun cor) +{ + u3_atom bat; + u3_atom pos; + u3_noun octs; + + u3x_mean(cor, u3x_sam_2, &bat, + u3x_sam_6, &pos, + u3x_sam_7, &octs, 0); + + return _qe_bytestream_seek_byte(bat, pos, octs); +} + +u3_noun +_qe_bytestream_read_byte(u3_atom pos, u3_noun octs) +{ + c3_w pos_w; + + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w; + c3_w len_w, lead_w; + + c3_y* sea_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + if (pos_w + 1 > p_octs_w) { + u3m_bail(c3__exit); + } + + c3_y bat_y; + + if (pos_w < len_w) { + bat_y = *(sea_y + pos_w); + } + else { + bat_y = 0; + } + + u3_noun new_bays = u3nc(u3i_word(pos_w + 1), u3k(octs)); + + return u3nc(bat_y, new_bays); +} + +u3_noun +u3we_bytestream_read_byte(u3_noun cor) +{ + u3_atom pos; + u3_noun octs; + + u3x_mean(cor, u3x_sam_2, &pos, + u3x_sam_3, &octs, 0); + + return _qe_bytestream_read_byte(pos, octs); +} + +u3_noun +_qe_bytestream_read_octs(u3_atom n, u3_atom pos, u3_noun octs) +{ + c3_w n_w, pos_w; + + if (c3n == u3r_safe_word(n, &n_w)) { + return u3_none; + } + + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + if (n_w == 0) { + return u3nc(u3nc(0,0), u3nc(u3k(pos), u3k(octs))); + } + + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w; + c3_w len_w, lead_w; + + c3_y* sea_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + if (pos_w + n_w > p_octs_w) { + u3m_bail(c3__exit); + } + + // Number of bytes to read, excluding leading zeros + // + c3_w red_w = n_w; + + if (pos_w + n_w > len_w) { + if (pos_w < len_w) { + red_w = len_w - pos_w; + } + // leading zeros - nothing to read + // + else { + red_w = 0; + } + } + + u3_noun read_octs; + + if (red_w == 0) { + read_octs = u3nc(u3i_word(n_w), 0); + } + else { + u3i_slab sab_u; + u3i_slab_bare(&sab_u, 3, n_w); + sab_u.buf_w[sab_u.len_w - 1] = 0; + + memcpy(sab_u.buf_y, sea_y + pos_w, red_w); + + if (red_w < n_w) { + memset(sab_u.buf_y + red_w, 0, (n_w - red_w)); + } + + read_octs = u3nc(u3i_word(n_w), u3i_slab_moot(&sab_u)); + } + + u3_noun new_bays = u3nc(u3i_word(pos_w + n_w), u3k(octs)); + + return u3nc(read_octs, new_bays); +} + +u3_noun +u3we_bytestream_read_octs(u3_noun cor) +{ + u3_atom n; + u3_atom pos; + u3_noun octs; + + u3x_mean(cor, u3x_sam_2, &n, + u3x_sam_6, &pos, + u3x_sam_7, &octs, 0); + + return _qe_bytestream_read_octs(n, pos, octs); +} + + +u3_noun +_qe_peek_octs(c3_w n_w, c3_w pos_w, c3_w p_octs_w, c3_y* sea_y, + c3_w len_w) +{ + if (n_w == 0) { + return u3nc(0, 0); + } + + if (pos_w + n_w > p_octs_w) { + return u3m_bail(c3__exit); + } + + // Read leading zeros only + // + if (pos_w >= len_w) { + return u3nc(u3i_word(n_w), 0); + } + // Number of remaining buffer bytes + c3_w reb_w = len_w - pos_w; + + u3i_slab sab_u; + c3_w my_len_w; + + if (n_w < reb_w) { + my_len_w = n_w; + } + else { + my_len_w = reb_w; + } + u3i_slab_bare(&sab_u, 3, my_len_w); + sab_u.buf_w[sab_u.len_w - 1] = 0; + memcpy(sab_u.buf_y, sea_y + pos_w, my_len_w); + + return u3nc(u3i_word(n_w), u3i_slab_moot(&sab_u)); +} +u3_noun _qe_bytestream_chunk(u3_atom size, u3_noun pos, u3_noun octs) +{ + c3_w size_w, pos_w; + + if (c3n == u3r_safe_word(size, &size_w)) { + return u3_none; + } + + if (size_w == 0) { + return u3_nul; + } + + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w; + c3_w len_w, lead_w; + + c3_y* sea_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + u3_noun hun = u3_nul; + + while (pos_w < p_octs) { + // Remaining bytes + // + c3_w rem = (p_octs - pos_w); + + if (rem < size) { + u3_noun octs = _qe_peek_octs(rem, pos_w, p_octs_w, sea_y, + len_w); + hun = u3nc(octs, hun); + pos_w += rem; + } + else { + u3_noun octs = _qe_peek_octs(size, pos_w, p_octs_w, sea_y, + len_w); + hun = u3nc(octs, hun); + pos_w += size; + } + } + + return u3kb_flop(hun); +} + +u3_noun +u3we_bytestream_chunk(u3_noun cor) +{ + u3_atom size; + u3_atom pos; + u3_noun octs; + + u3x_mean(cor, u3x_sam_2, &size, + u3x_sam_6, &pos, + u3x_sam_7, &octs, 0); + + return _qe_bytestream_chunk(size, pos, octs); +} + +u3_noun +_qe_bytestream_extract(u3_noun sea, u3_noun rac) +{ + u3_atom pos; + u3_noun octs; + + u3x_mean(sea, 2, &pos, 3, &octs, 0); + + c3_w pos_w; + + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w; + c3_w len_w, lead_w; + + c3_y* sea_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + u3_noun dal = u3_nul; + + u3_noun new_sea = u3_none; + + while (pos_w < p_octs_w) { + new_sea = u3nc(u3i_word(pos_w), u3k(octs)); + u3_noun ext = u3x_good(u3n_slam_on(u3k(rac), new_sea)); + + u3_atom sip, ken; + c3_w sip_w, ken_w; + + u3x_mean(ext, 2, &sip, 3, &ken, 0); + + if (c3n == u3r_safe_word(sip, &sip_w)) { + // XX is u3z necessary here? + // does memory get freed on bail? + // + u3l_log("bytestream: sip fail"); + u3z(dal); + u3z(ext); + return u3_none; + } + + if (c3n == u3r_safe_word(ken, &ken_w)) { + u3l_log("bytestream: ken fail"); + u3z(dal); + u3z(ext); + return u3_none; + } + + u3z(ext); + + if (sip_w == 0 && ken_w == 0) { + break; + } + + if (pos_w + sip_w > p_octs_w) { + u3z(dal); + return u3_none; + } + + pos_w += sip_w; + + if (ken_w == 0) { + continue; + } + + u3_noun octs = _qe_peek_octs(ken_w, pos_w, p_octs_w, sea_y, len_w); + pos_w += ken_w; + dal = u3nc(octs, dal); + } + + new_sea = u3nc(u3i_word(pos_w), u3k(octs)); + + return u3nc(u3kb_flop(dal), new_sea); +} +u3_noun +u3we_bytestream_extract(u3_noun cor) +{ + u3_noun sea; + u3_noun rac; + + u3x_mean(cor, u3x_sam_2, &sea, + u3x_sam_3, &rac, 0); + + return _qe_bytestream_extract(sea, rac); +} + +u3_noun +_qe_bytestream_fuse_extract(u3_noun sea, u3_noun rac) +{ + u3_atom pos; + u3_noun octs; + + u3x_mean(sea, 2, &pos, 3, &octs, 0); + + c3_w pos_w; + + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w; + c3_w len_w, lead_w; + + c3_y* sea_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + u3_noun dal = u3_nul; + + u3_noun new_sea = u3_none; + + while (pos_w < p_octs_w) { + new_sea = u3nc(u3i_word(pos_w), u3k(octs)); + u3_noun ext = u3x_good(u3n_slam_on(u3k(rac), new_sea)); + + u3_atom sip, ken; + c3_w sip_w, ken_w; + + u3x_mean(ext, 2, &sip, 3, &ken, 0); + + if (c3n == u3r_safe_word(sip, &sip_w)) { + // XX is u3z necessary here? + // does memory get freed on bail? + // + u3l_log("bytestream: sip fail"); + u3z(dal); + u3z(ext); + return u3_none; + } + if (c3n == u3r_safe_word(ken, &ken_w)) { + u3l_log("bytestream: ken fail"); + u3z(dal); + u3z(ext); + return u3_none; + } + + u3z(ext); + + if (sip_w == 0 && ken_w == 0) { + break; + } + + if (pos_w + sip_w > p_octs_w) { + u3z(dal); + return u3_none; + } + + pos_w += sip_w; + + if (ken_w == 0) { + continue; + } + + u3_noun octs = _qe_peek_octs(ken_w, pos_w, p_octs_w, sea_y, len_w); + pos_w += ken_w; + dal = u3nc(octs, dal); + } + + u3_noun lad = u3kb_flop(dal); + u3_noun data = _qe_bytestream_can_octs(lad); + u3z(lad); + + new_sea = u3nc(u3i_word(pos_w), u3k(octs)); + + return u3nc(data, new_sea); +} + +u3_noun +u3we_bytestream_fuse_extract(u3_noun cor) +{ + u3_noun sea; + u3_noun rac; + + u3x_mean(cor, u3x_sam_2, &sea, + u3x_sam_3, &rac, 0); + + return _qe_bytestream_fuse_extract(sea, rac); +} + +#define BITS_D (sizeof(c3_d)*8) + +u3_noun +_qe_bytestream_need_bits(u3_atom n, u3_noun bits) +{ + u3_atom num, bit; + u3_noun bays; + + u3x_mean(bits, 2, &num, + 6, &bit, + 7, &bays, 0); + + + c3_w n_w, num_w; + c3_d bit_d; + + if (c3n == u3r_safe_word(n, &n_w)) { + return u3_none; + } + if (c3n == u3r_safe_word(num, &num_w)) { + return u3_none; + } + if (c3n == u3r_safe_chub(bit, &bit_d)) { + return u3_none; + } + + if (num_w >= n_w) { + return u3k(bits); + } + + // How many bytes to read + // + c3_w need_bits_w = n_w - num_w; + + // Requires indirect atom, drop to Hoon + // + if (need_bits_w > BITS_D) { + return u3_none; + } + + c3_w need_bytes_w = need_bits_w / 8; + + if (need_bits_w % 8) { + need_bytes_w += 1; + } + + c3_w pos_w; + u3_atom pos; + u3_noun octs; + + + u3x_mean(bays, 2, &pos, 3, &octs, 0); + + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + u3_atom p_octs, q_octs; + + _x_octs(octs, &p_octs, &q_octs); + + c3_w p_octs_w; + c3_w len_w, lead_w; + + c3_y* sea_y; + + if (c3n == _x_octs_buffer(&p_octs, &q_octs, + &p_octs_w, &sea_y, + &len_w, &lead_w)) { + return u3_none; + } + + if (pos_w + need_bytes_w > p_octs_w) { + u3m_bail(c3__exit); + } + + while (need_bytes_w--) { + + if (pos_w < len_w) { + bit_d += *(sea_y + pos_w) << num_w; + } + num_w += 8; + pos_w++; + + u3_assert(num_w <= BITS_D); + } + + u3_noun new_bays = u3nc(u3i_word(pos_w), u3k(octs)); + + return u3nt(u3i_word(num_w), u3i_chub(bit_d), new_bays); +} +// +$ bits $+ bits +// $: num=@ud +// bit=@ub +// =bays +// == +u3_noun +u3we_bytestream_need_bits(u3_noun cor) +{ + u3_atom n; + u3_noun bits; + + u3x_mean(cor, u3x_sam_2, &n, + u3x_sam_3, &bits, 0); + + return _qe_bytestream_need_bits(n, bits); +} + +u3_noun +_qe_bytestream_drop_bits(u3_atom n, u3_noun bits) +{ + + u3_atom num, bit; + u3_noun bays; + + u3x_mean(bits, 2, &num, + 6, &bit, + 7, &bays, 0); + + c3_w n_w, num_w; + c3_d bit_d; + + if (c3n == u3r_safe_word(n, &n_w)) { + return u3_none; + } + if (c3n == u3r_safe_word(num, &num_w)) { + return u3_none; + } + if (c3n == u3r_safe_chub(bit, &bit_d)) { + return u3_none; + } + + if(n_w == 0) { + return u3k(bits); + } + + c3_w dop_w = n_w; + + if (dop_w > num_w) { + dop_w = num_w; + } + + bit_d >>= dop_w; + num_w -= dop_w; + + return u3nt(u3i_word(num_w), u3i_chub(bit_d), u3k(bays)); +} +u3_noun +u3we_bytestream_drop_bits(u3_noun cor) +{ + u3_atom n; + u3_noun bits; + + u3x_mean(cor, u3x_sam_2, &n, + u3x_sam_3, &bits, 0); + + return _qe_bytestream_drop_bits(n, bits); +} + +u3_noun +_qe_bytestream_peek_bits(u3_atom n, u3_noun bits) +{ + + u3_atom num, bit; + u3_noun bays; + + u3x_mean(bits, 2, &num, + 6, &bit, + 7, &bays, 0); + + c3_w n_w, num_w; + c3_d bit_d; + + if (c3n == u3r_safe_word(n, &n_w)) { + return u3_none; + } + if (c3n == u3r_safe_word(num, &num_w)) { + return u3_none; + } + if (c3n == u3r_safe_chub(bit, &bit_d)) { + return u3_none; + } + + if (n_w == 0) { + return u3i_word(0); + } + + if (n_w > num_w) { + u3m_bail(c3__exit); + } + + if (n_w > BITS_D) { + return u3_none; + } + + if (n_w == BITS_D) { + return u3i_chub(bit_d); + } + else { + c3_d mak_d = ((c3_d)1 << n_w) - 1; + + return u3i_chub(bit_d & mak_d); + } +} +u3_noun +u3we_bytestream_peek_bits(u3_noun cor) +{ + u3_atom n; + u3_noun bits; + + u3x_mean(cor, u3x_sam_2, &n, + u3x_sam_3, &bits, 0); + + return _qe_bytestream_peek_bits(n, bits); +} + +u3_noun +_qe_bytestream_read_bits(u3_atom n, u3_noun bits) +{ + + u3_atom num, bit; + u3_noun bays; + + u3x_mean(bits, 2, &num, + 6, &bit, + 7, &bays, 0); + + c3_w n_w, num_w; + c3_d bit_d; + + if (c3n == u3r_safe_word(n, &n_w)) { + return u3_none; + } + if (c3n == u3r_safe_word(num, &num_w)) { + return u3_none; + } + if (c3n == u3r_safe_chub(bit, &bit_d)) { + return u3_none; + } + + if (n_w > num_w) { + u3m_bail(c3__exit); + } + + if (n_w > BITS_D) { + return u3_none; + } + + c3_d bet_d = 0; + + if (n_w == BITS_D) { + bet_d = bit_d; + } + else { + c3_d mak_d = ((c3_d)1 << n_w) - 1; + bet_d = bit_d & mak_d; + } + + bit_d >>= n_w; + num_w -= n_w; + + u3_noun new_bits = u3nt(u3i_word(num_w), u3i_chub(bit_d), u3k(bays)); + + return u3nc(u3i_chub(bet_d), new_bits); +} + +u3_noun +u3we_bytestream_read_bits(u3_noun cor) +{ + u3_atom n; + u3_noun bits; + + u3x_mean(cor, u3x_sam_2, &n, + u3x_sam_3, &bits, 0); + + return _qe_bytestream_read_bits(n, bits); +} + +u3_noun +_qe_bytestream_byte_bits(u3_noun bits) +{ + + u3_atom num, bit; + u3_noun bays; + + u3x_mean(bits, 2, &num, + 6, &bit, + 7, &bays, 0); + + c3_w num_w; + c3_d bit_d; + + if (c3n == u3r_safe_word(num, &num_w)) { + return u3_none; + } + if (c3n == u3r_safe_chub(bit, &bit_d)) { + return u3_none; + } + + c3_y rem_y = num_w & 0x7; + + if (rem_y == 0) { + return u3k(bits); + } + + u3_noun new_bits = u3nt(u3i_word(num_w - rem_y), + u3i_chub(bit_d >> rem_y), + u3k(bays)); + + return new_bits; +} + +u3_noun +u3we_bytestream_byte_bits(u3_noun cor) +{ + u3_noun bits; + + u3x_mean(cor, u3x_sam, &bits, 0); + + return _qe_bytestream_byte_bits(bits); +} diff --git a/vere/pkg/noun/jets/e/chacha.c b/vere/pkg/noun/jets/e/chacha.c new file mode 100644 index 0000000..e42f8e2 --- /dev/null +++ b/vere/pkg/noun/jets/e/chacha.c @@ -0,0 +1,74 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqe_chacha_crypt(u3_atom rounds, u3_atom key, u3_atom nonce, u3_atom counter, u3_atom wid, u3_atom dat) + { + c3_w rounds_w, wid_w; + c3_d counter_d; + if ( !u3r_word_fit(&rounds_w, rounds) || !u3r_word_fit(&wid_w, wid) || c3n == u3r_safe_chub(counter, &counter_d) ) { + return u3m_bail(c3__fail); + } + else { + c3_y key_y[32], nonce_y[8]; + u3r_bytes(0, 32, key_y, key); + u3r_bytes(0, 8, nonce_y, nonce); + c3_y *dat_y = u3r_bytes_alloc(0, wid_w, dat); + urcrypt_chacha_crypt(rounds_w, key_y, nonce_y, counter_d, wid_w, dat_y); + u3_noun cry = u3i_bytes(wid_w, dat_y); + u3a_free(dat_y); + return u3i_cell(wid, cry); + } + } + + u3_noun + u3we_chacha_crypt(u3_noun cor) + { + u3_noun sam = u3x_at(u3x_sam, cor); + u3_noun rounds, key, nonce, counter, msg; + u3_noun wid, dat; + + if ( u3r_quil(sam, &rounds, &key, &nonce, &counter, &msg) || + u3ud(rounds) || u3ud(key) || u3ud(nonce) || u3ud(counter) || u3r_cell(msg, &wid, &dat) ) + { + return u3m_bail(c3__exit); + } else { + return u3l_punt("chacha_crypt", _cqe_chacha_crypt(rounds, key, nonce, counter, wid, dat)); + } + } + + + static u3_noun + _cqe_chacha_xchacha(u3_atom rounds, u3_atom key, u3_atom nonce) + { + c3_w rounds_w; + if ( !u3r_word_fit(&rounds_w, rounds) ) { + return u3m_bail(c3__fail); + } + c3_y key_y[32], nonce_y[64], xkey_y[32], xnonce_y[8]; + u3r_bytes(0, 32, key_y, key); + u3r_bytes(0, 24, nonce_y, nonce); + urcrypt_chacha_xchacha(rounds, key_y, nonce_y, xkey_y, xnonce_y); + return u3i_cell(u3i_bytes(32, xkey_y), u3i_bytes(8, xnonce_y)); + } + + u3_noun + u3we_chacha_xchacha(u3_noun cor) + { + u3_noun sam = u3x_at(u3x_sam, cor); + u3_noun rounds, key, nonce; + if ( c3n == u3r_trel(sam, &rounds, &key, &nonce) || + c3n == u3ud(rounds) || + c3n == u3ud(key) || + c3n == u3ud(nonce) ) + { + return u3m_bail(c3__exit); + } else { + return u3l_punt("chacha_xchacha", _cqe_chacha_xchacha(rounds, key, nonce)); + } + } diff --git a/vere/pkg/noun/jets/e/crc.c b/vere/pkg/noun/jets/e/crc.c new file mode 100644 index 0000000..496b8d5 --- /dev/null +++ b/vere/pkg/noun/jets/e/crc.c @@ -0,0 +1,59 @@ +/// @file + +#include <stdio.h> +#include <allocate.h> +#include "zlib.h" + +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qe_crc32(u3_noun input_octs) +{ + u3_atom head = u3h(input_octs); + u3_atom tail = u3t(input_octs); + c3_w tel_w = u3r_met(3, tail); + c3_w hed_w; + if ( c3n == u3r_safe_word(head, &hed_w) ) { + return u3m_bail(c3__fail); + } + c3_y* input; + + if (c3y == u3a_is_cat(tail)) { + input = (c3_y*)&tail; + } + else { + u3a_atom* vat_u = u3a_to_ptr(tail); + input = (c3_y*)vat_u->buf_w; + } + + if ( tel_w > hed_w ) { + return u3m_error("subtract-underflow"); + } + + c3_w led_w = hed_w - tel_w; + c3_w crc_w = 0; + + crc_w = crc32(crc_w, input, tel_w); + + while ( led_w > 0 ) { + c3_y byt_y = 0; + crc_w = crc32(crc_w, &byt_y, 1); + led_w--; + } + + return u3i_word(crc_w); +} + +u3_noun +u3we_crc32(u3_noun cor) +{ + u3_noun a = u3r_at(u3x_sam, cor); + + if ( (u3du(a) == c3y) && (u3ud(u3h(a)) == c3y) && (u3ud(u3t(a)) == c3y) ) { + return u3qe_crc32(a); + } else { + return u3m_bail(c3__exit); + } +} diff --git a/vere/pkg/noun/jets/e/cue.c b/vere/pkg/noun/jets/e/cue.c new file mode 100644 index 0000000..643b408 --- /dev/null +++ b/vere/pkg/noun/jets/e/cue.c @@ -0,0 +1,27 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qe_cue(u3_atom a) +{ + return u3s_cue_atom(a); +} + +u3_noun +u3we_cue(u3_noun cor) +{ + return u3qe_cue(u3x_atom(u3x_at(u3x_sam, cor))); +} + +u3_noun +u3ke_cue(u3_atom a) +{ + u3_noun b = u3qe_cue(a); + u3z(a); + return b; +} diff --git a/vere/pkg/noun/jets/e/ed_add_double_scalarmult.c b/vere/pkg/noun/jets/e/ed_add_double_scalarmult.c new file mode 100644 index 0000000..6512919 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_add_double_scalarmult.c @@ -0,0 +1,72 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_add_double_scalarmult(u3_atom a, + u3_atom a_point, + u3_atom b, + u3_atom b_point) + { + c3_y a_y[32], a_point_y[32], + b_y[32], b_point_y[32], + out_y[32]; + c3_w met_w; + + met_w = u3r_met(3, a); + if ( (32 < met_w) || + ( (32 == met_w) && + (127 < u3r_byte(31, a)) ) + ) { + u3_noun a_recs = u3qee_recs(a); + u3r_bytes(0, 32, a_y, a_recs); + u3z(a_recs); + } else { + u3r_bytes(0, 32, a_y, a); + } + + met_w = u3r_met(3, b); + if ( (32 < met_w) || + ( (32 == met_w) && + (127 < u3r_byte(31, b)) ) + ) { + u3_noun b_recs = u3qee_recs(b); + u3r_bytes(0, 32, b_y, b_recs); + u3z(b_recs); + } else { + u3r_bytes(0, 32, b_y, b); + } + + if ( (0 != u3r_bytes_fit(32, a_point_y, a_point)) || + (0 != u3r_bytes_fit(32, b_point_y, b_point)) || + (0 != urcrypt_ed_add_double_scalarmult(a_y, a_point_y, b_y, b_point_y, out_y)) ) { + return u3m_bail(c3__exit); + } + else { + return u3i_bytes(32, out_y); + } + } + + u3_noun + u3wee_add_double_scalarmult(u3_noun cor) + { + u3_noun a, b, c, d; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, + u3x_sam_6, &b, + u3x_sam_14, &c, + u3x_sam_15, &d, 0)) || + (c3n == u3ud(a)) || + (c3n == u3ud(b)) || + (c3n == u3ud(c)) || + (c3n == u3ud(d)) ) + { + return u3m_bail(c3__exit); + } else { + return _cqee_add_double_scalarmult(a, b, c, d); + } + } diff --git a/vere/pkg/noun/jets/e/ed_add_scalarmult_scalarmult_base.c b/vere/pkg/noun/jets/e/ed_add_scalarmult_scalarmult_base.c new file mode 100644 index 0000000..39eda53 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_add_scalarmult_scalarmult_base.c @@ -0,0 +1,66 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_add_scalarmult_scalarmult_base(u3_atom a, + u3_atom a_point, + u3_atom b) + { + c3_y a_y[32], a_point_y[32], b_y[32], out_y[32]; + c3_w met_w; + + met_w = u3r_met(3, a); + if ( (32 < met_w) || + ( (32 == met_w) && + (127 < u3r_byte(31, a)) ) + ) { + u3_noun a_recs = u3qee_recs(a); + u3r_bytes(0, 32, a_y, a_recs); + u3z(a_recs); + } else { + u3r_bytes(0, 32, a_y, a); + } + + met_w = u3r_met(3, b); + if ( (32 < met_w) || + ( (32 == met_w) && + (127 < u3r_byte(31, b)) ) + ) { + u3_noun b_recs = u3qee_recs(b); + u3r_bytes(0, 32, b_y, b_recs); + u3z(b_recs); + } else { + u3r_bytes(0, 32, b_y, b); + } + + if ( (0 != u3r_bytes_fit(32, a_point_y, a_point)) || + (0 != urcrypt_ed_add_scalarmult_scalarmult_base(a_y, a_point_y, b_y, out_y)) ) { + return u3m_bail(c3__exit); + } + else { + return u3i_bytes(32, out_y); + } + } + + u3_noun + u3wee_add_scalarmult_scalarmult_base(u3_noun cor) + { + u3_noun a, b, c; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, + u3x_sam_6, &b, + u3x_sam_7, &c, 0)) || + (c3n == u3ud(a)) || + (c3n == u3ud(b)) || + (c3n == u3ud(c)) ) + { + return u3m_bail(c3__exit); + } else { + return _cqee_add_scalarmult_scalarmult_base(a, b, c); + } + } diff --git a/vere/pkg/noun/jets/e/ed_luck.c b/vere/pkg/noun/jets/e/ed_luck.c new file mode 100644 index 0000000..c21889e --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_luck.c @@ -0,0 +1,37 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_luck(u3_atom sed) + { + c3_y sed_y[32]; + + if ( 0 != u3r_bytes_fit(32, sed_y, sed) ) { + // hoon explicitly crashes on mis-size + return u3m_bail(c3__exit); + } + else { + c3_y pub_y[32]; + c3_y sec_y[64]; + urcrypt_ed_luck(sed_y, pub_y, sec_y); + return u3nc(u3i_bytes(32, pub_y), u3i_bytes(64, sec_y)); + } + } + + u3_noun + u3wee_luck(u3_noun cor) + { + u3_noun a = u3r_at(u3x_sam, cor); + + if ( (u3_none == a) || (c3n == u3ud(a)) ) { + return u3m_bail(c3__exit); + } + else { + return _cqee_luck(a); + } + } diff --git a/vere/pkg/noun/jets/e/ed_point_add.c b/vere/pkg/noun/jets/e/ed_point_add.c new file mode 100644 index 0000000..70fe563 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_point_add.c @@ -0,0 +1,40 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + + static u3_atom + _cqee_point_add(u3_atom a, + u3_atom b) + { + c3_y a_y[32], b_y[32], out_y[32]; + + if ( (0 != u3r_bytes_fit(32, a_y, a)) || + (0 != u3r_bytes_fit(32, b_y, b)) || + (0 != urcrypt_ed_point_add(a_y, b_y, out_y)) ) { + return u3m_bail(c3__exit); + } + else { + return u3i_bytes(32, out_y); + } + } + + u3_noun + u3wee_point_add(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); + } else { + return _cqee_point_add(a, b); + } + } diff --git a/vere/pkg/noun/jets/e/ed_point_neg.c b/vere/pkg/noun/jets/e/ed_point_neg.c new file mode 100644 index 0000000..5a1a5bd --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_point_neg.c @@ -0,0 +1,37 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + + static u3_atom + _cqee_point_neg(u3_atom a) + { + c3_y a_y[32]; + + if ( (0 != u3r_bytes_fit(32, a_y, a)) || + (0 != urcrypt_ed_point_neg(a_y)) ) { + return u3m_bail(c3__exit); + } + else { + return u3i_bytes(32, a_y); + } + } + + u3_noun + u3wee_point_neg(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 _cqee_point_neg(a); + } + } diff --git a/vere/pkg/noun/jets/e/ed_puck.c b/vere/pkg/noun/jets/e/ed_puck.c new file mode 100644 index 0000000..98581d7 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_puck.c @@ -0,0 +1,36 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_puck(u3_atom sed) + { + c3_y sed_y[32]; + + if ( 0 != u3r_bytes_fit(32, sed_y, sed) ) { + // hoon explicitly crashes on mis-size + return u3m_bail(c3__exit); + } + else { + c3_y pub_y[32]; + urcrypt_ed_puck(sed_y, pub_y); + return u3i_bytes(32, pub_y); + } + } + + u3_noun + u3wee_puck(u3_noun cor) + { + u3_noun a = u3r_at(u3x_sam, cor); + + if ( (u3_none == a) || (c3n == u3ud(a)) ) { + return u3m_bail(c3__exit); + } + else { + return _cqee_puck(a); + } + } diff --git a/vere/pkg/noun/jets/e/ed_recs.c b/vere/pkg/noun/jets/e/ed_recs.c new file mode 100644 index 0000000..bdcf224 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_recs.c @@ -0,0 +1,48 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + // `@ux`(rev 3 32 l:ed:crypto) + static c3_y _cqee_l_prime[] = { + 0xed, 0xd3, 0xf5, 0x5c, 0x1a, 0x63, 0x12, 0x58, + 0xd6, 0x9c, 0xf7, 0xa2, 0xde, 0xf9, 0xde, 0x14, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, + }; + + u3_atom + u3qee_recs(u3_atom a) + { + c3_w met_w = u3r_met(3, a); + + if ( 64 < met_w ) { + u3_atom l_prime = u3i_bytes(32, _cqee_l_prime); + u3_atom pro = u3qa_mod(a, l_prime); + u3z(l_prime); + return pro; + } + + c3_y a_y[64]; + + u3r_bytes(0, 64, a_y, a); + urcrypt_ed_scalar_reduce(a_y); + return u3i_bytes(32, a_y); + } + + u3_noun + u3wee_recs(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 u3qee_recs(a); + } + } diff --git a/vere/pkg/noun/jets/e/ed_scad.c b/vere/pkg/noun/jets/e/ed_scad.c new file mode 100644 index 0000000..af95563 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_scad.c @@ -0,0 +1,124 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_scad(u3_atom pub, u3_atom sek, u3_atom sca) + { + c3_y pub_y[32]; + c3_y sek_y[64]; + c3_y sca_y[32]; + + if ( 0 != u3r_bytes_fit(32, pub_y, pub) ) { + // hoon explicitly crashes on mis-size + return u3m_bail(c3__exit); + } + if ( 0 != u3r_bytes_fit(64, sek_y, sek) ) { + // hoon explicitly crashes on mis-size + return u3m_bail(c3__exit); + } + if ( 0 != u3r_bytes_fit(32, sca_y, sca) ) { + // hoon explicitly crashes on mis-size + return u3m_bail(c3__exit); + } + else { + urcrypt_ed_add_scalar_public_private(pub_y, sek_y, sca_y); + return u3nc(u3i_bytes(32, pub_y), u3i_bytes(64, sek_y)); + } + } + + u3_noun + u3wee_scad(u3_noun cor) + { + u3_noun pub, sek, sca; + if ( (c3n == u3r_mean(cor, + u3x_sam_2, &pub, + u3x_sam_6, &sek, + u3x_sam_7, &sca, 0)) || + (c3n == u3ud(pub)) || + (c3n == u3ud(sek)) || + (c3n == u3ud(sca)) ) { + return u3m_bail(c3__exit); + } + else { + return _cqee_scad(pub, sek, sca); + } + } + + static u3_atom + _cqee_scas(u3_atom sek, u3_atom sca) + { + c3_y sek_y[64]; + c3_y sca_y[32]; + + if ( 0 != u3r_bytes_fit(64, sek_y, sek) ) { + // hoon explicitly crashes on mis-size + return u3m_bail(c3__exit); + } + if ( 0 != u3r_bytes_fit(32, sca_y, sca) ) { + // hoon explicitly crashes on mis-size + return u3m_bail(c3__exit); + } + else { + urcrypt_ed_add_scalar_private(sek_y, sca_y); + return u3i_bytes(64, sek_y); + } + } + + u3_noun + u3wee_scas(u3_noun cor) + { + u3_noun sek, sca; + if ( (c3n == u3r_mean(cor, + u3x_sam_2, &sek, + u3x_sam_3, &sca, 0)) || + (c3n == u3ud(sek)) || + (c3n == u3ud(sca)) ) { + return u3m_bail(c3__exit); + } + else { + return _cqee_scas(sek, sca); + } + } + + static u3_atom + _cqee_scap(u3_atom pub, u3_atom sca) + { + c3_y pub_y[32]; + c3_y sca_y[32]; + + if ( 0 != u3r_bytes_fit(32, pub_y, pub) ) { + // hoon explicitly crashes on mis-size + return u3m_bail(c3__exit); + } + if ( 0 != u3r_bytes_fit(32, sca_y, sca) ) { + // hoon explicitly crashes on mis-size + return u3m_bail(c3__exit); + } + else { + urcrypt_ed_add_scalar_public(pub_y, sca_y); + return u3i_bytes(32, pub_y); + } + } + + u3_noun + u3wee_scap(u3_noun cor) + { + u3_noun pub, sca; + if ( (c3n == u3r_mean(cor, + u3x_sam_2, &pub, + u3x_sam_3, &sca, 0)) || + (c3n == u3ud(pub)) || + (c3n == u3ud(sca)) ) { + return u3m_bail(c3__exit); + } + else { + return _cqee_scap(pub, sca); + } + } + + diff --git a/vere/pkg/noun/jets/e/ed_scalarmult.c b/vere/pkg/noun/jets/e/ed_scalarmult.c new file mode 100644 index 0000000..8585c29 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_scalarmult.c @@ -0,0 +1,54 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_scalarmult(u3_atom a, + u3_atom b) + { + c3_y a_y[32], b_y[32], out_y[32]; + if (0 != u3r_bytes_fit(32, b_y, b)) { + return u3m_bail(c3__exit); + } + + c3_w met_w = u3r_met(3, a); + // scalarmult expects a_y[31] <= 127 + if ( (32 < met_w) || + ( (32 == met_w) && + (127 < u3r_byte(31, a)) ) + ) { + u3_noun a_recs = u3qee_recs(a); + u3r_bytes(0, 32, a_y, a_recs); + u3z(a_recs); + } else { + u3r_bytes(0, 32, a_y, a); + } + + if ( (0 != urcrypt_ed_scalarmult(a_y, b_y, out_y)) ) { + // at this point, will only fail if b is bad point + return u3m_bail(c3__exit); + } + else { + return u3i_bytes(32, out_y); + } + } + + u3_noun + u3wee_scalarmult(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); + } else { + return _cqee_scalarmult(a, b); + } + } diff --git a/vere/pkg/noun/jets/e/ed_scalarmult_base.c b/vere/pkg/noun/jets/e/ed_scalarmult_base.c new file mode 100644 index 0000000..6193584 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_scalarmult_base.c @@ -0,0 +1,46 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_scalarmult_base(u3_atom a) + { + c3_y a_y[32], out_y[32]; + c3_w met_w = u3r_met(3, a); + // scalarmult_base expects a_y[31] <= 127 + if ( (32 < met_w) || + ( (32 == met_w) && + (127 < u3r_byte(31, a)) ) + ) { + u3_noun a_recs = u3qee_recs(a); + u3r_bytes(0, 32, a_y, a_recs); + u3z(a_recs); + } else { + u3r_bytes(0, 32, a_y, a); + } + + if (0 != urcrypt_ed_scalarmult_base(a_y, out_y)) { + // should be unreachable, as scalar already reduced + return u3m_bail(c3__exit); + } + else { + return u3i_bytes(32, out_y); + } + } + + u3_noun + u3wee_scalarmult_base(u3_noun cor) + { + u3_noun a = u3r_at(u3x_sam, cor); + + if ( (u3_none == a) || (c3n == u3ud(a)) ) { + return u3m_bail(c3__exit); + } + else { + return _cqee_scalarmult_base(a); + } + } diff --git a/vere/pkg/noun/jets/e/ed_shar.c b/vere/pkg/noun/jets/e/ed_shar.c new file mode 100644 index 0000000..ed293f7 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_shar.c @@ -0,0 +1,74 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_shar(u3_atom pub, u3_atom sed) + { + c3_y pub_y[32], sed_y[32]; + + if ( 0 != u3r_bytes_fit(32, pub_y, pub) ) { + return u3m_bail(c3__exit); + } + else if ( 0 != u3r_bytes_fit(32, sed_y, sed) ) { + // hoon calls luck, which crashes + return u3m_bail(c3__exit); + } + else { + c3_y shr_y[32]; + urcrypt_ed_shar(pub_y, sed_y, shr_y); + return u3i_bytes(32, shr_y); + } + } + + u3_noun + u3wee_shar(u3_noun cor) + { + u3_noun pub, sed; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &pub, u3x_sam_3, &sed, 0)) || + (c3n == u3ud(pub)) || + (c3n == u3ud(sed)) ) + { + return u3m_bail(c3__exit); + } else { + return _cqee_shar(pub, sed); + } + } + + static u3_atom + _cqee_slar(u3_atom pub, u3_atom sek) + { + c3_y pub_y[32], sek_y[64]; + + if ( 0 != u3r_bytes_fit(32, pub_y, pub) ) { + return u3m_bail(c3__exit); + } + else if ( 0 != u3r_bytes_fit(64, sek_y, sek) ) { + return u3m_bail(c3__exit); + } + else { + c3_y shr_y[32]; + urcrypt_ed_slar(pub_y, sek_y, shr_y); + return u3i_bytes(32, shr_y); + } + } + + u3_noun + u3wee_slar(u3_noun cor) + { + u3_noun pub, sek; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &pub, u3x_sam_3, &sek, 0)) || + (c3n == u3ud(pub)) || + (c3n == u3ud(sek)) ) + { + return u3m_bail(c3__exit); + } else { + return _cqee_slar(pub, sek); + } + } diff --git a/vere/pkg/noun/jets/e/ed_sign.c b/vere/pkg/noun/jets/e/ed_sign.c new file mode 100644 index 0000000..cd1797d --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_sign.c @@ -0,0 +1,166 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" +#include <retrieve.h> +#include <types.h> + + static u3_atom + _cqee_sign_octs(u3_noun len, u3_noun dat, u3_noun sed) + { + c3_y sed_y[32]; + c3_w len_w; + if ( 0 != u3r_bytes_fit(32, sed_y, sed) ) { + // hoon calls luck, which crashes + return u3m_bail(c3__exit); + } + else if ( !u3r_word_fit(&len_w, len) ) { + return u3m_bail(c3__fail); + } + else { + c3_y sig_y[64]; + c3_y* dat_y = u3r_bytes_alloc(0, len_w, dat); + urcrypt_ed_sign(dat_y, len_w, sed_y, sig_y); + u3a_free(dat_y); + return u3i_bytes(64, sig_y); + } + } + + u3_noun + u3wee_sign_octs(u3_noun cor) + { + u3_noun msg, sed; + u3_noun len, dat; + if ( c3n == u3r_mean(cor, u3x_sam_2, &msg, u3x_sam_3, &sed, 0) || + c3n == u3r_cell(msg, &len, &dat) || + c3n == u3ud(sed) || + c3n == u3ud(len) || + c3n == u3ud(dat) ) { + return u3m_bail(c3__fail); + } else { + return _cqee_sign_octs(len, dat, sed); + } + } + + static u3_atom + _cqee_sign_octs_raw(u3_noun len, u3_noun dat, u3_noun pub, u3_noun sek) + { + c3_y pub_y[32], sek_y[64]; + c3_w len_w; + if ( 0 != u3r_bytes_fit(32, pub_y, pub) ) { + // hoon asserts size + return u3m_bail(c3__exit); + } + if ( 0 != u3r_bytes_fit(64, sek_y, sek) ) { + // hoon asserts size + return u3m_bail(c3__exit); + } + else if ( !u3r_word_fit(&len_w, len) ) { + return u3m_bail(c3__fail); + } + else { + c3_y sig_y[64]; + c3_y* dat_y = u3r_bytes_alloc(0, len_w, dat); + urcrypt_ed_sign_raw(dat_y, len_w, pub_y, sek_y, sig_y); + u3a_free(dat_y); + return u3i_bytes(64, sig_y); + } + } + + u3_noun + u3wee_sign_octs_raw(u3_noun cor) + { + u3_noun msg, pub, sek; + u3_noun len, dat; + if ( c3n == u3r_mean(cor, u3x_sam_2, &msg, u3x_sam_6, &pub, u3x_sam_7, &sek, 0) || + c3n == u3r_cell(msg, &len, &dat) || + c3n == u3ud(pub) || + c3n == u3ud(sek) || + c3n == u3ud(len) || + c3n == u3ud(dat) ) { + return u3m_bail(c3__fail); + } else { + return _cqee_sign_octs_raw(len, dat, pub, sek); + } + } + + static u3_atom + _cqee_sign(u3_noun msg, + u3_noun sed) + { + c3_y sed_y[32]; + + if ( 0 != u3r_bytes_fit(32, sed_y, sed) ) { + // hoon calls luck, which crashes + return u3m_bail(c3__exit); + } + else { + c3_y sig_y[64]; + c3_w met_w; + c3_y* msg_y = u3r_bytes_all(&met_w, msg); + + urcrypt_ed_sign(msg_y, met_w, sed_y, sig_y); + u3a_free(msg_y); + + return u3i_bytes(64, sig_y); + } + } + + u3_noun + u3wee_sign(u3_noun cor) + { + u3_noun msg, sed; + if ( c3n == u3r_mean(cor, + u3x_sam_2, &msg, u3x_sam_3, &sed, 0) || + c3n == u3ud(msg) || + c3n == u3ud(sed) ) { + return u3m_bail(c3__fail); + } else { + return _cqee_sign(msg, sed); + } + } + + static u3_atom + _cqee_sign_raw(u3_noun msg, + u3_noun pub, + u3_noun sek) + { + c3_y pub_y[32], sek_y[64]; + + if ( 0 != u3r_bytes_fit(32, pub_y, pub) ) { + // hoon asserts size + return u3m_bail(c3__exit); + } + if ( 0 != u3r_bytes_fit(64, sek_y, sek) ) { + // hoon asserts size + return u3m_bail(c3__exit); + } + else { + c3_y sig_y[64]; + c3_w met_w; + c3_y* msg_y = u3r_bytes_all(&met_w, msg); + + urcrypt_ed_sign_raw(msg_y, met_w, pub_y, sek_y, sig_y); + u3a_free(msg_y); + + return u3i_bytes(64, sig_y); + } + } + + u3_noun + u3wee_sign_raw(u3_noun cor) + { + u3_noun msg, pub, sek; + if ( c3n == u3r_mean(cor, + u3x_sam_2, &msg, u3x_sam_6, &pub, u3x_sam_7, &sek, 0) || + c3n == u3ud(msg) || + c3n == u3ud(pub) || + c3n == u3ud(sek) ) { + return u3m_bail(c3__fail); + } else { + return _cqee_sign_raw(msg, pub, sek); + } + } diff --git a/vere/pkg/noun/jets/e/ed_smac.c b/vere/pkg/noun/jets/e/ed_smac.c new file mode 100644 index 0000000..ce0ffac --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_smac.c @@ -0,0 +1,73 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_smac(u3_atom a, + u3_atom b, + u3_atom c) + { + c3_y a_y[32], b_y[32], c_y[32], out_y[32]; + c3_w met_w; + + met_w = u3r_met(3, a); + if ( (32 < met_w) || + ( (32 == met_w) && + (127 < u3r_byte(31, a)) ) + ) { + u3_noun a_recs = u3qee_recs(a); + u3r_bytes(0, 32, a_y, a_recs); + u3z(a_recs); + } else { + u3r_bytes(0, 32, a_y, a); + } + + met_w = u3r_met(3, b); + if ( (32 < met_w) || + ( (32 == met_w) && + (127 < u3r_byte(31, b)) ) + ) { + u3_noun b_recs = u3qee_recs(b); + u3r_bytes(0, 32, b_y, b_recs); + u3z(b_recs); + } else { + u3r_bytes(0, 32, b_y, b); + } + + met_w = u3r_met(3, c); + if ( (32 < met_w) || + ( (32 == met_w) && + (127 < u3r_byte(31, c)) ) + ) { + u3_noun c_recs = u3qee_recs(c); + u3r_bytes(0, 32, c_y, c_recs); + u3z(c_recs); + } else { + u3r_bytes(0, 32, c_y, c); + } + + urcrypt_ed_scalar_muladd(a_y, b_y, c_y, out_y); + return u3i_bytes(32, out_y); + } + + u3_noun + u3wee_smac(u3_noun cor) + { + u3_noun a, b, c; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, + u3x_sam_6, &b, + u3x_sam_7, &c, 0)) || + (c3n == u3ud(a)) || + (c3n == u3ud(b)) || + (c3n == u3ud(c)) ) + { + return u3m_bail(c3__exit); + } else { + return _cqee_smac(a, b, c); + } + } diff --git a/vere/pkg/noun/jets/e/ed_veri.c b/vere/pkg/noun/jets/e/ed_veri.c new file mode 100644 index 0000000..6d7b750 --- /dev/null +++ b/vere/pkg/noun/jets/e/ed_veri.c @@ -0,0 +1,85 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqee_veri_octs(u3_noun sig, + u3_noun len, + u3_noun dat, + u3_noun pub) + { + c3_y sig_y[64], pub_y[32]; + c3_w len_w; + if ( (0 != u3r_bytes_fit(64, sig_y, sig)) || + (0 != u3r_bytes_fit(32, pub_y, pub)) || + !u3r_word_fit(&len_w, len) ) { + return c3n; + } + else { + c3_y* dat_y = u3r_bytes_alloc(0, len_w, dat); + c3_t val_t = urcrypt_ed_veri(dat_y, len_w, pub_y, sig_y); + u3a_free(dat_y); + + return val_t ? c3y : c3n; + } + } + + u3_noun + u3wee_veri_octs(u3_noun cor) + { + u3_noun sig, msg, pub; + u3_noun len, dat; + if ( c3n == u3r_mean(cor, + u3x_sam_2, &sig, u3x_sam_6, &msg, + u3x_sam_7, &pub, 0) || + c3n == u3r_cell(msg, &len, &dat) || + (c3n == u3ud(sig)) || + (c3n == u3ud(pub)) || + (c3n == u3ud(len)) || + (c3n == u3ud(dat)) ) { + return u3m_bail(c3__fail); + } else { + return _cqee_veri_octs(sig, len, dat, pub); + } + } + + static u3_atom + _cqee_veri(u3_noun s, + u3_noun m, + u3_noun pk) + { + c3_y sig_y[64], pub_y[32]; + + if ( (0 != u3r_bytes_fit(64, sig_y, s)) || + (0 != u3r_bytes_fit(32, pub_y, pk)) ) { + return c3n; + } + else { + c3_w met_w; + c3_y* mes_y = u3r_bytes_all(&met_w, m); + c3_t val_t = urcrypt_ed_veri(mes_y, met_w, pub_y, sig_y); + u3a_free(mes_y); + + return val_t ? c3y : c3n; + } + } + + u3_noun + u3wee_veri(u3_noun cor) + { + u3_noun a, b, c; + if ( (c3n == u3r_mean(cor, + u3x_sam_2, &a, u3x_sam_6, &b, + u3x_sam_7, &c, 0)) || + (c3n == u3ud(a)) || + (c3n == u3ud(b)) || + (c3n == u3ud(c)) ) { + return u3m_bail(c3__fail); + } else { + return _cqee_veri(a, b, c); + } + } diff --git a/vere/pkg/noun/jets/e/fein_ob.c b/vere/pkg/noun/jets/e/fein_ob.c new file mode 100644 index 0000000..65d0f3a --- /dev/null +++ b/vere/pkg/noun/jets/e/fein_ob.c @@ -0,0 +1,90 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "murmur3.h" + +// +feis:ob constant parameters to +fe:ob +// +static const c3_w a_w = 0xffff; +static const c3_w b_w = 0x10000; +static const c3_w k_w = 0xffff0000; + +// +raku:ob +// +static const c3_w rak_w[4] = { 0xb76d5eed, 0xee281300, 0x85bcae01, 0x4b387af7 }; + +/* _fe_ob(): +fe:ob, with constant parameters factored out. +** correct over the domain [0x0, 0xfffe.ffff] +*/ +static c3_w +_fe_ob(c3_w m_w) +{ + c3_w l_w = m_w % a_w; + c3_w r_w = m_w / a_w; + c3_w f_w, t_w; + c3_y j_y, k_y[2]; + + for ( j_y = 0; j_y < 4; j_y++ ) { + k_y[0] = r_w & 0xff; + k_y[1] = (r_w >> 8) & 0xff; + + MurmurHash3_x86_32(k_y, 2, rak_w[j_y], &f_w); + + // NB: this addition can overflow a c3_w (before mod) + // + t_w = ((c3_d)f_w + l_w) % (!(j_y & 1) ? a_w : b_w); + l_w = r_w; + r_w = t_w; + } + + // legendary @max19 + // + return ( a_w == r_w ) + ? (r_w * a_w) + l_w + : (l_w * a_w) + r_w; +} + +/* _feis_ob(): +feis:ob, also offsetting by 0x1.000 (as in +fein:ob). +** correct over the domain [0x1.0000, 0xffff.ffff] +*/ +static c3_w +_feis_ob(c3_w m_w) +{ + c3_w c_w = _fe_ob(m_w - b_w); + return b_w + (( c_w < k_w ) ? c_w : _fe_ob(c_w)); +} + +u3_atom +u3qe_fein_ob(u3_atom pyn) +{ + c3_w sor_w = u3r_met(4, pyn); + + if ( (sor_w < 2) || (sor_w > 4) ) { + return u3k(pyn); + } + + if ( 2 == sor_w ) { + return u3i_word(_feis_ob(u3r_word(0, pyn))); + } + else { + c3_w pyn_w[2]; + u3r_words(0, 2, pyn_w, pyn); + + if ( pyn_w[0] < b_w ) { + return u3k(pyn); + } + else { + pyn_w[0] = _feis_ob(pyn_w[0]); + return u3i_words(2, pyn_w); + } + } +} + +u3_noun +u3we_fein_ob(u3_noun cor) +{ + return u3qe_fein_ob(u3x_atom(u3x_at(u3x_sam, cor))); +} diff --git a/vere/pkg/noun/jets/e/fl.c b/vere/pkg/noun/jets/e/fl.c new file mode 100644 index 0000000..c52309e --- /dev/null +++ b/vere/pkg/noun/jets/e/fl.c @@ -0,0 +1,441 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +/* structures +*/ + typedef struct _flOptions { + c3_w precision; + mpz_t minExp; + mpz_t expWidth; + c3_w rMode; + c3_w eMode; + } flOptions; + + typedef struct _ea { + mpz_t e; + mpz_t a; + } ea; + + static void + _satom_to_mp(mpz_t a_mp, + u3_atom b) + { + if ( _(u3a_is_cat(b)) ) { + c3_ws c = (b + 1) >> 1; + if ( (b & 1) ) { + c = -c; + } + mpz_init_set_si(a_mp, c); + } + else { + u3r_mp(a_mp, b); + c3_t x = mpz_odd_p(a_mp); + mpz_add_ui(a_mp, a_mp, 1); + mpz_tdiv_q_2exp(a_mp, a_mp, 1); + if ( x ) { + mpz_neg(a_mp, a_mp); + } + } + } + + static u3_noun + _mp_to_satom(mpz_t a_mp) + { + c3_ws b = mpz_sgn(a_mp); + switch ( b ) { + default: return u3m_bail(c3__fail); + case 0: { + mpz_clear(a_mp); + return 0; + } + case 1: { + mpz_mul_2exp(a_mp, a_mp, 1); + return u3i_mp(a_mp); + } + case -1: { + mpz_abs(a_mp, a_mp); + mpz_mul_2exp(a_mp, a_mp, 1); + mpz_sub_ui(a_mp, a_mp, 1); + return u3i_mp(a_mp); + } + } + } + + static void + _noun_to_flOptions(flOptions* a, + u3_noun b) + { + u3_noun c; + u3_atom d, e, f, g, h; + u3x_trel(b, &c, &d, &e); + u3x_trel(c, &f, &g, &h); + + mpz_t i; + u3r_mp(i, f); + if ( !mpz_fits_uint_p(i) ) { + mpz_clear(i); + u3m_bail(c3__exit); + } + a->precision = mpz_get_ui(i); + mpz_clear(i); + + if ( a->precision < 2 ) u3m_bail(c3__exit); + + _satom_to_mp(a->minExp, g); + u3r_mp(a->expWidth, h); + + if ( !(_(u3a_is_cat(d)) && _(u3a_is_cat(e))) ) { + mpz_clear(a->minExp); + mpz_clear(a->expWidth); + u3m_bail(c3__exit); + } + a->rMode = d; + a->eMode = e; + } + + static void + _noun_to_ea(ea* a, + u3_noun b) + { + u3_atom c, d; + u3x_cell(b, &c, &d); + + if ( !(_(u3a_is_cat(c))) ) { + u3m_bail(c3__exit); + } + + _satom_to_mp(a->e, c); + u3r_mp(a->a, d); + } + + static u3_noun + _ea_to_noun(ea* a) + { + u3_atom b = _mp_to_satom(a->e); + u3_atom c = u3i_mp(a->a); + + return u3nc(b, c); + } + + static void + _xpd(ea* a, + flOptions* b) + { + size_t z = mpz_sizeinbase(a->a, 2); + if ( z >= b->precision ) return; + c3_w c = b->precision - z; + + if ( b->eMode != c3__i ) { + mpz_t i; + mpz_init_set(i, a->e); + mpz_sub(i, i, b->minExp); + if ( mpz_sgn(i) < 0 ) { + c = 0; + } + else if ( mpz_fits_uint_p(i) ) + { + c3_w d = mpz_get_ui(i); + c = c3_min(c, d); + } + mpz_clear(i); + } + + mpz_mul_2exp(a->a, a->a, c); + mpz_sub_ui(a->e, a->e, c); + } + + /* a: floating point number, b: flOptions, i: rounding mode, j: sticky bit */ + u3_noun + u3qef_lug(u3_noun a, + u3_noun b, + u3_atom i, + u3_atom j) + { + mpz_t v, g, h; + ea c; + flOptions d; + _noun_to_ea(&c, a); + _noun_to_flOptions(&d, b); + if ( mpz_sgn(c.a) == 0 ) { + mpz_clear(d.minExp); mpz_clear(d.expWidth); + mpz_clear(c.a); mpz_clear(c.e); + return u3m_bail(c3__exit); + } + size_t m = mpz_sizeinbase(c.a, 2); + if ( !_(j) && (m <= d.precision) ) { + mpz_clear(d.minExp); mpz_clear(d.expWidth); + mpz_clear(c.a); mpz_clear(c.e); + return u3m_bail(c3__exit); + } + c3_w q = 0; + c3_w f = (m > d.precision) ? m - d.precision : 0; + mpz_init(g); + if ( (d.eMode != c3__i) && + (mpz_cmp(c.e, d.minExp) < 0) ) { + mpz_sub(g, d.minExp, c.e); + if ( !mpz_fits_uint_p(g) ) { + mpz_clear(g); + mpz_clear(d.minExp); mpz_clear(d.expWidth); + mpz_clear(c.a); mpz_clear(c.e); + return u3m_bail(c3__exit); + } + q = mpz_get_ui(g); + } + q = c3_max(f, q); + mpz_init(v); + mpz_tdiv_r_2exp(v, c.a, q); + mpz_tdiv_q_2exp(c.a, c.a, q); + mpz_add_ui(c.e, c.e, q); + mpz_init_set_ui(h, 1); + if ( q > 0 ) mpz_mul_2exp(h, h, q - 1); + + if ( mpz_sgn(c.a) == 0 ) { + c3_t y; + switch ( i ) { + default: + mpz_clear(v); mpz_clear(h); mpz_clear(g); + mpz_clear(d.minExp); mpz_clear(d.expWidth); + mpz_clear(c.a); mpz_clear(c.e); + return u3m_bail(c3__exit); + case c3__fl: + case c3__sm: + mpz_set_ui(c.a, 0); + mpz_set_ui(c.e, 0); + mpz_clear(v); mpz_clear(h); mpz_clear(g); + break; + case c3__ce: + case c3__lg: + mpz_set_ui(c.a, 1); + mpz_set(c.e, d.minExp); + mpz_clear(v); mpz_clear(h); mpz_clear(g); + break; + case c3__ne: + case c3__nt: + case c3__na: + if ( (i != c3__na) && _(j) ) { + y = (mpz_cmp(v, h) <= 0); + } else { + y = (mpz_cmp(v, h) < 0); + } + if ( y ) { + mpz_set_ui(c.a, 0); + mpz_set_ui(c.e, 0); + } else { + mpz_set_ui(c.a, 1); + mpz_set(c.e, d.minExp); + } + mpz_clear(v); mpz_clear(h); mpz_clear(g); + break; + } + goto end; + } + _xpd(&c, &d); + switch ( i ) { + c3_ws x; + default: + mpz_clear(v); mpz_clear(h); mpz_clear(g); + mpz_clear(d.minExp); mpz_clear(d.expWidth); + mpz_clear(c.a); mpz_clear(c.e); + return u3m_bail(c3__exit); + case c3__fl: + break; + case c3__lg: + mpz_add_ui(c.a, c.a, 1); + break; + case c3__sm: + if ( (mpz_sgn(v) != 0) || !_(j) ) break; + if ( (mpz_cmp(c.e, d.minExp) == 0) && (d.eMode != c3__i) ) { + mpz_sub_ui(c.a, c.a, 1); + break; + } + mpz_mul_2exp(g, c.a, 1); + mpz_sub_ui(g, g, 1); + if ( mpz_sizeinbase(g, 2) <= d.precision ) { + mpz_sub_ui(c.e, c.e, 1); + mpz_set(c.a, g); + } else { + mpz_sub_ui(c.a, c.a, 1); + } + break; + case c3__ce: + if ( (mpz_sgn(v) != 0) || !_(j) ) { + mpz_add_ui(c.a, c.a, 1); + } + break; + case c3__ne: + if ( mpz_sgn(v) == 0 ) break; + x = mpz_cmp(v, h); + if ( (x == 0) && _(j) ) { + if ( mpz_odd_p(c.a) ) { + mpz_add_ui(c.a, c.a, 1); + } + } + else if ( x >= 0 ) { + mpz_add_ui(c.a, c.a, 1); + } + break; + case c3__na: + case c3__nt: + if ( mpz_sgn(v) == 0 ) break; + x = mpz_cmp(v, h); + if ( (x < 0) ) break; + if ( (i == c3__nt) && (x == 0) ) { + if (!_(j)) mpz_add_ui(c.a, c.a, 1); + } else { + mpz_add_ui(c.a, c.a, 1); + } + break; + } + if ( mpz_sizeinbase(c.a, 2) == (d.precision + 1) ) { + mpz_tdiv_q_2exp(c.a, c.a, 1); + mpz_add_ui(c.e, c.e, 1); + } + if ( mpz_sgn(c.a) == 0 ) { + mpz_set_ui(c.e, 0); + mpz_clear(v); mpz_clear(h); mpz_clear(g); + goto end; + } + mpz_set(g, d.minExp); + mpz_add(g, g, d.expWidth); + if ( (d.eMode != c3__i) && (mpz_cmp(g, c.e) < 0) ) { + mpz_clear(v); mpz_clear(h); mpz_clear(g); + mpz_clear(d.minExp); mpz_clear(d.expWidth); + mpz_clear(c.a); mpz_clear(c.e); + return u3nc(c3__i, c3y); + } + mpz_clear(v); mpz_clear(h); mpz_clear(g); + + // all mpz except in c, d structures cleared; c contains result + end: + if ( d.eMode == c3__f ) { + if ( mpz_sizeinbase(c.a, 2) != d.precision ) { + mpz_set_ui(c.a, 0); + mpz_set_ui(c.e, 0); + } + } + u3_noun ret = u3nq(c3__f, c3y, _mp_to_satom(c.e), u3i_mp(c.a)); + mpz_clear(d.minExp); mpz_clear(d.expWidth); + return ret; + } + + u3_noun + u3wef_lug(u3_noun cor) + { + u3_noun a, b, c, d, e; + a = u3x_at(u3x_sam, cor); + b = u3x_at(30, cor); + u3x_trel(a, &c, &d, &e); + + return u3qef_lug(d, b, c, e); + } + + u3_noun + u3qef_drg(u3_noun a, + u3_noun b) + { + ea c; + flOptions d; + _noun_to_ea(&c, a); + _noun_to_flOptions(&d, b); + if ( mpz_sgn(c.a) == 0 ) { + mpz_clear(d.minExp); mpz_clear(d.expWidth); + mpz_clear(c.a); mpz_clear(c.e); + u3m_bail(c3__exit); + } + _xpd(&c, &d); + if ( !mpz_fits_sint_p(c.e) ) { + mpz_clear(d.minExp); mpz_clear(d.expWidth); + mpz_clear(c.a); mpz_clear(c.e); + u3m_bail(c3__exit); + } + mpz_t r, s, mn, mp, i, j, u, o; + mpz_init_set(r, c.a); + mpz_init_set_ui(s, 1); + mpz_init_set_ui(mn, 1); + mpz_init(i); + mpz_init(j); + c3_w se = mpz_sgn(c.e); + if ( se == 1 ) { + mpz_mul_2exp(r, r, mpz_get_ui(c.e)); + mpz_mul_2exp(mn, mn, mpz_get_ui(c.e)); + } + else if ( se == -1 ) { + mpz_mul_2exp(s, s, mpz_get_ui(c.e)); + } + mpz_init_set(mp, mn); + mpz_set_ui(i, 1); + mpz_mul_2exp(i, i, d.precision - 1); + if ( (mpz_cmp(c.a, i) == 0) && + ((mpz_cmp(c.e, d.minExp) != 0 ) || + (d.eMode == c3__i)) ) { + mpz_mul_2exp(mp, mp, 1); + mpz_mul_2exp(r, r, 1); + mpz_mul_2exp(s, s, 1); + } + mpz_cdiv_q_ui(i, s, 10); + mpz_set_ui(c.e, 0); + while ( mpz_cmp(r, i) < 0 ) { + mpz_sub_ui(c.e, c.e, 1); + mpz_mul_ui(r, r, 10); + mpz_mul_ui(mn, mn, 10); + mpz_mul_ui(mp, mp, 10); + } + while ( 1 ) { + mpz_mul_2exp(i, r, 1); + mpz_add(i, i, mp); + mpz_mul_2exp(j, s, 1); + if ( mpz_cmp(i, j) < 0 ) { + break; + } + mpz_mul_ui(s, s, 10); + mpz_add_ui(c.e, c.e, 1); + } + mpz_init(u); + mpz_init_set_ui(o, 0); + while ( 1 ) { + mpz_sub_ui(c.e, c.e, 1); + mpz_mul_ui(r, r, 10); + mpz_mul_ui(mn, mn, 10); + mpz_mul_ui(mp, mp, 10); + mpz_tdiv_qr(u, r, r, s); + mpz_mul_2exp(i, r, 1); + mpz_mul_2exp(j, s, 1); + c3_t l = mpz_cmp(i, mn) < 0; + c3_t h = mpz_cmp(j, mp) < 0; + if ( !h ) { + mpz_sub(j, j, mp); + h = mpz_cmp(i, j) > 0; + } + if ( l || h ) { + mpz_mul_ui(o, o, 10); + mpz_add(o, o, u); + if ( h && (!l || (mpz_cmp(i, s) > 0)) ) { + mpz_add_ui(o, o, 1); + } + break; + } + mpz_mul_ui(o, o, 10); + mpz_add(o, o, u); + } + mpz_set(c.a, o); + mpz_clear(r); mpz_clear(s); + mpz_clear(mn); mpz_clear(mp); + mpz_clear(i); mpz_clear(j); mpz_clear(u); + mpz_clear(o); mpz_clear(d.minExp); mpz_clear(d.expWidth); + + return _ea_to_noun(&c); + } + + u3_noun + u3wef_drg(u3_noun cor) + { + u3_noun a, b; + a = u3x_at(u3x_sam, cor); + b = u3x_at(30, cor); + + return u3qef_drg(a, b); + } diff --git a/vere/pkg/noun/jets/e/fynd_ob.c b/vere/pkg/noun/jets/e/fynd_ob.c new file mode 100644 index 0000000..62e65d1 --- /dev/null +++ b/vere/pkg/noun/jets/e/fynd_ob.c @@ -0,0 +1,94 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "murmur3.h" + +// +tail:ob constant parameters to +fe:ob +// +static const c3_w a_w = 0xffff; +static const c3_w b_w = 0x10000; +static const c3_w k_w = 0xffff0000; + +// (flop raku:ob) +// +static const c3_w kar_w[4] = { 0x4b387af7, 0x85bcae01, 0xee281300, 0xb76d5eed }; + +/* _fen_ob(): +fen:ob, with constant parameters factored out. +** correct over the domain [0x0 ... 0xfffe.ffff] +*/ +static c3_w +_fen_ob(c3_w m_w) +{ + c3_w l_w = m_w / a_w; + c3_w r_w = m_w % a_w; + c3_w f_w, t_w; + c3_y j_y, k_y[2]; + + // legendary @max19 + // + if ( a_w == l_w ) { + t_w = l_w; + l_w = r_w; + r_w = t_w; + } + + for ( j_y = 0; j_y < 4; j_y++ ) { + k_y[0] = l_w & 0xff; + k_y[1] = (l_w >> 8) & 0xff; + + MurmurHash3_x86_32(k_y, 2, kar_w[j_y], &f_w); + + t_w = ( j_y & 1 ) + ? ((r_w + a_w) - (f_w % a_w)) % a_w + : ((r_w + b_w) - (f_w % b_w)) % b_w; + r_w = l_w; + l_w = t_w; + } + + return (r_w * a_w) + l_w; +} + +/* _tail_ob(): +feis:ob, also offsetting by 0x1.000 (as in +fynd:ob). +** correct over the domain [0x1.0000, 0xffff.ffff] +*/ +static c3_w +_tail_ob(c3_w m_w) +{ + c3_w c_w = _fen_ob(m_w - b_w); + return b_w + (( c_w < k_w ) ? c_w : _fen_ob(c_w)); +} + +u3_atom +u3qe_fynd_ob(u3_atom pyn) +{ + c3_w sor_w = u3r_met(4, pyn); + + if ( (sor_w < 2) || (sor_w > 4) ) { + return u3k(pyn); + } + + if ( 2 == sor_w ) { + return u3i_word(_tail_ob(u3r_word(0, pyn))); + } + else { + c3_w pyn_w[2]; + u3r_words(0, 2, pyn_w, pyn); + + if ( pyn_w[0] < b_w ) { + return u3k(pyn); + } + else { + pyn_w[0] = _tail_ob(pyn_w[0]); + return u3i_words(2, pyn_w); + } + } +} + +u3_noun +u3we_fynd_ob(u3_noun cor) +{ + return u3qe_fynd_ob(u3x_atom(u3x_at(u3x_sam, cor))); +} diff --git a/vere/pkg/noun/jets/e/hmac.c b/vere/pkg/noun/jets/e/hmac.c new file mode 100644 index 0000000..b14ec1e --- /dev/null +++ b/vere/pkg/noun/jets/e/hmac.c @@ -0,0 +1,94 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qe_hmac(u3_noun haj, + u3_atom boq, + u3_atom out, + u3_atom wik, + u3_atom key, + u3_atom wid, + u3_atom dat) + { + u3_assert(_(u3a_is_cat(boq)) && _(u3a_is_cat(wik)) && _(u3a_is_cat(wid))); + + // prep the hashing gate + u3j_site sit_u; + u3j_gate_prep(&sit_u, u3k(haj)); + + // ensure key and message fit signaled lengths + key = u3qc_end(3, wik, key); + dat = u3qc_end(3, wid, dat); + + // keys longer than block size are shortened by hashing + if (wik > boq) { + key = u3j_gate_slam(&sit_u, u3nc(wik, key)); + wik = out; + } + + // keys shorter than block size are right-padded + if (wik < boq) { + key = u3kc_lsh(3, (boq - wik), key); + } + + // pad key, inner and outer + c3_y trail = (boq % 4); + c3_y padwords = (boq / 4) + (trail == 0 ? 0 : 1); + c3_w innpad[padwords], outpad[padwords]; + memset(innpad, 0x36, padwords * 4); + memset(outpad, 0x5c, padwords * 4); + if ( trail > 0 ) { + innpad[padwords-1] = 0x36363636 >> (8 * (4 - trail)); + outpad[padwords-1] = 0x5c5c5c5c >> (8 * (4 - trail)); + } + u3_atom innkey = u3kc_mix(u3k(key), u3i_words(padwords, innpad)); + u3_atom outkey = u3kc_mix( key , u3i_words(padwords, outpad)); + + // append inner padding to message, then hash + u3_atom innmsg = u3ka_add(u3kc_lsh(3, wid, innkey), dat); + u3_atom innhaj = u3j_gate_slam(&sit_u, u3nc((wid + boq), innmsg)); + + // prepend outer padding to result, hash again + u3_atom outmsg = u3ka_add(u3kc_lsh(3, out, outkey), innhaj); + u3_atom outhaj = u3j_gate_slam(&sit_u, u3nc((out + boq), outmsg)); + + u3j_gate_lose(&sit_u); + return outhaj; + } + + u3_noun + u3we_hmac(u3_noun cor) + { + u3_noun haj, boq, out, wik, key, wid, dat; + + // sample is [[haj boq out] [wik key] [wid dat]] + if ( (c3n == u3r_mean(cor, u3x_sam_4, &haj, + 50, &boq, // +<->- + 51, &out, // +<->+ + u3x_sam_12, &wik, + u3x_sam_13, &key, + u3x_sam_14, &wid, + u3x_sam_15, &dat, 0)) || + (c3n == u3ud(boq)) || + (c3n == u3a_is_cat(boq)) || + (c3n == u3ud(out)) || + (c3n == u3a_is_cat(out)) || + (c3n == u3ud(wik)) || + (c3n == u3a_is_cat(wik)) || + (c3n == u3ud(key)) || + (c3n == u3ud(wid)) || + (c3n == u3a_is_cat(wid)) || + (c3n == u3ud(dat)) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qe_hmac(haj, boq, out, wik, key, wid, dat); + } + } diff --git a/vere/pkg/noun/jets/e/jam.c b/vere/pkg/noun/jets/e/jam.c new file mode 100644 index 0000000..2291bc0 --- /dev/null +++ b/vere/pkg/noun/jets/e/jam.c @@ -0,0 +1,60 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qe_jam(u3_atom a) +{ +#if 0 + if (c3y == u3du(a) && 1337 == u3h(a)) { + c3_w siz_w, tot_w = 0; + u3_noun som; + for ( som = u3t(a); c3y == u3du(som); som = u3t(som) ) { + siz_w = u3a_count_noun(u3h(som)); + tot_w += siz_w; + if ( 0 == siz_w ) { + u3l_log("item: B/0"); + } + else { + u3a_print_memory(stderr, "item", siz_w); + } + } + if ( u3_blip != som ) { + u3l_log("forgot to terminate list!"); + } + c3_w mem_w = u3h_count(u3R->cax.har_p); + + for ( som = u3t(a); c3y == u3du(som); som = u3t(som) ) u3a_discount_noun(u3h(som)); + u3h_discount(u3R->cax.har_p); + + u3a_print_memory(stderr, "total", tot_w); + u3a_print_memory(stderr, "memoization cache", mem_w); + u3h_root* har_u = u3to(u3h_root, u3R->cax.har_p); + u3l_log("memoization entries: %d", har_u->use_w); + u3a_print_memory(stderr, "unused free", u3a_open(u3R)); + return tot_w; + } +#endif + + u3i_slab sab_u; + u3s_jam_fib(&sab_u, a); + return u3i_slab_mint(&sab_u); +} + +u3_noun +u3we_jam(u3_noun cor) +{ + return u3qe_jam(u3x_at(u3x_sam, cor)); +} + +u3_atom +u3ke_jam(u3_noun a) +{ + u3_atom b = u3qe_jam(a); + u3z(a); + return b; +} diff --git a/vere/pkg/noun/jets/e/json_de.c b/vere/pkg/noun/jets/e/json_de.c new file mode 100644 index 0000000..e54393a --- /dev/null +++ b/vere/pkg/noun/jets/e/json_de.c @@ -0,0 +1,258 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +#include "pdjson.h" + +/* +** custom code for interfacing with external parser: +** https://github.com/skeeto/pdjson +*/ + +typedef struct _u3qedj_coll { + u3_noun col; // collection (list for array, map for object) + union { // store context for recursive arrays/objects: + u3_noun* tel; // - pointer to tail for array + u3_atom key; // - key for object + }; +} u3qedj_coll; + +static u3qedj_coll* +_push_stack(const u3a_pile *pil_u) +{ + u3qedj_coll *res_u = u3a_push(pil_u); + u3a_pile_done(pil_u); + + res_u->col = u3_nul; + res_u->key = u3_none; + + return res_u; +} + +static u3qedj_coll* +_pop_stack(const u3a_pile *pil_u) +{ + return u3a_pop(pil_u); +} + +static void +_close_stack(const u3a_pile *pil_u) +{ + while ( c3n == u3a_pile_done(pil_u) ) { + u3qedj_coll *tak_u = u3a_peek(pil_u); + + u3z(tak_u->col); + if ( u3_none != tak_u->key ) { + u3z(tak_u->key); + } + + u3a_drop(pil_u); + } +} + +static void +_close_on_error(json_stream *sam_u, const u3a_pile *pil_u) +{ + _close_stack(pil_u); + json_close(sam_u); +} + +static u3_atom +_json_get_string_as_atom(json_stream *sam_u) { + // length returned by json_get_string includes the trailing null byte + // it's possible for json_get_string to return a length of 0, but only if: + // - it's called directly after init + // - it's called directly after init_string + size_t len_i; + const c3_c *str_c = json_get_string(sam_u, &len_i); + return (len_i <= 1) ? + u3_nul : + u3i_bytes(len_i - 1, (const c3_y *)str_c); +} + +static u3_noun +_parse(u3_atom txt) +{ + // + // vars + // + + u3qedj_coll *tak_u; + + json_allocator loc_u = {u3a_malloc, u3a_realloc, u3a_free}; + json_stream sem_u; + json_stream* sam_u = &sem_u; + + u3a_pile pel_u; + u3a_pile *pil_u = &pel_u; + + u3_noun res = u3_none; + u3_noun val; + + const c3_y *byt_y; + c3_z cnt_z; + c3_w len_w = u3r_met(3, txt); + + // + // initialization + // + + // XX assumes little-endian + // + if ( c3y == u3a_is_cat(txt) ) { + byt_y = (c3_y*)&txt; + } + else { + u3a_atom* vat_u = u3a_to_ptr(txt); + byt_y = (c3_y*)vat_u->buf_w; + } + json_open_buffer(sam_u, byt_y, len_w); + json_set_allocator(sam_u, &loc_u); + u3a_pile_prep(pil_u, sizeof(u3qedj_coll)); + + // + // core logic + // + + while ( json_peek(sam_u) != JSON_DONE ) { + switch ( json_next(sam_u) ) { + // unreachable barring programming error + default: u3_assert(0); + + case JSON_ARRAY: + case JSON_OBJECT: { + tak_u = _push_stack(pil_u); + } continue; + + case JSON_ARRAY_END: { + val = u3nc(c3__a, tak_u->col); + tak_u = _pop_stack(pil_u); + } break; + + case JSON_OBJECT_END: { + val = u3nc(c3__o, tak_u->col); + tak_u = _pop_stack(pil_u); + } break; + + case JSON_STRING: { + if ( (json_get_context(sam_u, &cnt_z) == JSON_OBJECT) && (cnt_z & 1) ) { + // since object key must be followed by value, skip ahead + tak_u->key = _json_get_string_as_atom(sam_u); + continue; + } + else { + val = u3nc(c3__s, _json_get_string_as_atom(sam_u)); + break; + } + } + + case JSON_NUMBER: { + // read number from string in the JSON reparser + val = u3nc(c3__n, _json_get_string_as_atom(sam_u)); + } break; + + case JSON_TRUE: { + val = u3nc(c3__b, c3y); + } break; + + case JSON_FALSE: { + val = u3nc(c3__b, c3n); + } break; + + case JSON_NULL: { + val = u3_nul; + } break; + + case JSON_ERROR: { + _close_on_error(sam_u, pil_u); + return u3_nul; + } break; + } + + switch ( json_get_context(sam_u, &cnt_z) ) { + // unreachable barring programming error + default: u3_assert(0); + + case JSON_DONE: { + res = val; + } break; + + case JSON_ARRAY: { + u3_noun* nex; + u3_noun* hed; + + if ( tak_u->col == u3_nul ) { + nex = &(tak_u->col); + } + else { + nex = tak_u->tel; + } + + *nex = u3i_defcons(&hed, &(tak_u->tel)); + *hed = val; + *(tak_u->tel) = u3_nul; + } break; + + case JSON_OBJECT: { + // odd cnt_z and unset key weeded out by continue command on key + u3_assert(!(cnt_z & 1)); + u3_assert(tak_u->key != u3_none); + // cnt_z == 0 weeded out by continue command on array/object open + u3_assert(cnt_z); + + tak_u->col = u3kdb_put(tak_u->col, tak_u->key, val); + tak_u->key = u3_none; + } break; + } + } + + // + // clean up + // + + u3_assert(c3y == u3a_pile_done(pil_u)); + + // skip over whitespce + while ( json_isspace(json_source_peek(sam_u)) ) { + json_source_get(sam_u); + } + + json_close(sam_u); + + // return null if trailing trash/multiple JSON objects + if ( json_get_position(sam_u) != len_w ) { + u3z(res); + return u3_nul; + } + else { + return u3nc(u3_nul, res); + } +} + +/* +** jet interface functions +*/ + +u3_noun +u3qe_json_de(u3_atom a) +{ + return _parse(a); +} + +u3_noun +u3ke_json_de(u3_atom a) +{ + u3_noun res = u3qe_json_de(a); + u3z(a); + return res; +} + +u3_noun +u3we_json_de(u3_noun cor) +{ + return u3qe_json_de(u3x_atom(u3x_at(u3x_sam, cor))); +} diff --git a/vere/pkg/noun/jets/e/json_en.c b/vere/pkg/noun/jets/e/json_en.c new file mode 100644 index 0000000..f605ab4 --- /dev/null +++ b/vere/pkg/noun/jets/e/json_en.c @@ -0,0 +1,416 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +/* +** structs +*/ + +typedef struct _json_buffer { + c3_y *buf_y; + c3_w len_w; +} json_buffer; + +/* +** constants +*/ + +const c3_y _JSON_NULL[] = "null"; +const c3_y _JSON_TRUE[] = "true"; +const c3_y _JSON_FALSE[] = "false"; +const c3_y _JSON_NEWLINE[] = "\\n"; +const c3_y _JSON_DOQ[] = "\\\""; +const c3_y _JSON_BAS[] = "\\\\"; +const c3_y _JSON_DEL[] = "\\u007f"; +const c3_y *_JSON_UNICODES[] = { + (c3_y*)"\\u0000", // 0 + (c3_y*)"\\u0001", // 1 + (c3_y*)"\\u0002", // 2 + (c3_y*)"\\u0003", // 3 + (c3_y*)"\\u0004", // 4 + (c3_y*)"\\u0005", // 5 + (c3_y*)"\\u0006", // 6 + (c3_y*)"\\u0007", // 7 + (c3_y*)"\\u0008", // 8 + (c3_y*)"\\u0009", // 9 + (c3_y*)"\\u000a", // 10 + (c3_y*)"\\u000b", // 11 + (c3_y*)"\\u000c", // 12 + (c3_y*)"\\u000d", // 13 + (c3_y*)"\\u000e", // 14 + (c3_y*)"\\u000f", // 15 + (c3_y*)"\\u0010", // 16 + (c3_y*)"\\u0011", // 17 + (c3_y*)"\\u0012", // 18 + (c3_y*)"\\u0013", // 19 + (c3_y*)"\\u0014", // 20 + (c3_y*)"\\u0015", // 21 + (c3_y*)"\\u0016", // 22 + (c3_y*)"\\u0017", // 23 + (c3_y*)"\\u0018", // 24 + (c3_y*)"\\u0019", // 25 + (c3_y*)"\\u001a", // 26 + (c3_y*)"\\u001b", // 27 + (c3_y*)"\\u001c", // 28 + (c3_y*)"\\u001d", // 29 + (c3_y*)"\\u001e", // 30 + (c3_y*)"\\u001f", // 31 +}; + +/* +** forward declarations +*/ + +static c3_w +_measure(u3_noun a); + +static void +_serialize(json_buffer*, u3_noun); + +/* +** core jet logic +*/ + +static void +_append_char(json_buffer *buf_u, c3_y c_y) +{ + buf_u->buf_y[(buf_u->len_w)++] = c_y; +} + +static void +_append_text(json_buffer *buf_u, const c3_y *buf_y, c3_w len_w) +{ + memcpy(&(buf_u->buf_y[buf_u->len_w]), buf_y, len_w); + buf_u->len_w += len_w; +} + +static c3_w +_measure_loobean(u3_noun a) +{ + switch ( a ) { + default: u3m_bail(c3__exit); + case c3y: return sizeof(_JSON_TRUE) - 1; + case c3n: return sizeof(_JSON_FALSE) - 1; + } +} + +static void +_serialize_loobean(json_buffer *buf_u, u3_noun a) +{ + switch ( a ) { + default: u3_assert(0); + case c3y: _append_text(buf_u, _JSON_TRUE, sizeof(_JSON_TRUE) - 1); break; + case c3n: _append_text(buf_u, _JSON_FALSE, sizeof(_JSON_FALSE) - 1); break; + } +} + +static c3_w +_measure_number(u3_noun a) +{ + if ( _(u3du(a)) ) { + u3m_bail(c3__exit); + } + + return u3r_met(3, a); +} + +static void +_serialize_number(json_buffer *buf_u, u3_noun a) +{ + const 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; + } + + _append_text(buf_u, byt_y, u3r_met(3, a)); +} + +static c3_w +_measure_string(u3_noun a) +{ + if ( _(u3du(a)) ) { + u3m_bail(c3__exit); + } + + c3_w len_w = u3r_met(3, a); + c3_w siz_w = 0; + + for (c3_w i = 0; i < len_w; ++i) { + c3_y c_y = u3r_byte(i, a); + + switch ( c_y ) { + case 0 ... 9: + case 11 ... 31: { + siz_w += 6; + } break; + + case 10: { + siz_w += sizeof(_JSON_NEWLINE) - 1; + } break; + + case 34: { + siz_w += sizeof(_JSON_DOQ) - 1; + } break; + + case 92: { + siz_w += sizeof(_JSON_BAS) - 1; + } break; + + case 127: { + siz_w += sizeof(_JSON_DEL) - 1; + } break; + + default: { + siz_w += 1; + } break; + } + } + + // surrounding double quotes + return (siz_w + 2); +} + +static void +_serialize_string(json_buffer *buf_u, u3_noun a) +{ + c3_w len_w = u3r_met(3, a); + + _append_char(buf_u, '"'); + for (c3_w i = 0; i < len_w; ++i) { + c3_y c_y = u3r_byte(i, a); + + switch ( c_y ) { + case 0 ... 9: + case 11 ... 31: { + _append_text(buf_u, _JSON_UNICODES[c_y], 6); + } break; + + case 10: { + _append_text(buf_u, _JSON_NEWLINE, sizeof(_JSON_NEWLINE) - 1); + } break; + + case 34: { + _append_text(buf_u, _JSON_DOQ, sizeof(_JSON_DOQ) - 1); + } break; + + case 92: { + _append_text(buf_u, _JSON_BAS, sizeof(_JSON_BAS) - 1); + } break; + + case 127: { + _append_text(buf_u, _JSON_DEL, sizeof(_JSON_DEL) - 1); + } break; + + default: { + _append_char(buf_u, c_y); + } break; + } + } + _append_char(buf_u, '"'); +} + +static c3_w +_measure_array(u3_noun a) +{ + if ( u3_nul != a ) { + u3_noun i, t = a; + // array open brace + c3_w siz_w = 1; + + while ( u3_nul != t ) { + u3x_cell(t, &i, &t); + siz_w += _measure(i); + // comma or array close brace + siz_w += 1; + } + + return siz_w; + } + else { + // empty array + return 2; + } +} + +static void +_serialize_array(json_buffer *buf_u, u3_noun a) +{ + _append_char(buf_u, '['); + + if ( u3_nul != a ) { + u3_noun i, t = a; + + while ( u3_nul != t ) { + u3x_cell(t, &i, &t); + _serialize(buf_u, i); + _append_char(buf_u, ','); + } + + // Remove trailing comma from array contents + --buf_u->len_w; + } + + _append_char(buf_u, ']'); +} + +static c3_w +_measure_object_helper(u3_noun a) +{ + c3_w siz_w = 0; + + if ( u3_nul != a ) { + u3_noun n_a, l_a, r_a; + u3_noun pn_a, qn_a; + u3x_trel(a, &n_a, &l_a, &r_a); + u3x_cell(n_a, &pn_a, &qn_a); + + siz_w += _measure_object_helper(r_a); + siz_w += _measure_object_helper(l_a); + + siz_w += _measure_string(pn_a); + siz_w += _measure(qn_a); + + // colon and comma (or closing brace) + siz_w += 2; + } + + return siz_w; +} + +static void +_serialize_object_helper(json_buffer *buf_u, u3_noun a) +{ + if ( u3_nul != a ) { + u3_noun n_a, l_a, r_a; + u3_noun pn_a, qn_a; + u3x_trel(a, &n_a, &l_a, &r_a); + u3x_cell(n_a, &pn_a, &qn_a); + + // order is important to match unjetted tree traversal + _serialize_object_helper(buf_u, r_a); + + _serialize_string(buf_u, pn_a); + _append_char(buf_u, ':'); + _serialize(buf_u, qn_a); + _append_char(buf_u, ','); + + _serialize_object_helper(buf_u, l_a); + } +} + +static c3_w +_measure_object(u3_noun a) +{ + if ( u3_nul != a ) { + // opening brace + return 1 + _measure_object_helper(a); + } + else { + // empty object + return 2; + } +} + +static void +_serialize_object(json_buffer *buf_u, u3_noun a) +{ + _append_char(buf_u, '{'); + + if ( u3_nul != a ) { + _serialize_object_helper(buf_u, a); + + // Remove trailing comma from object contents + --buf_u->len_w; + } + + _append_char(buf_u, '}'); +} + +static c3_w +_measure(u3_noun a) +{ + if ( u3_nul == a ) { + return sizeof(_JSON_NULL) - 1; + } + else { + u3_noun s, p; + u3x_cell(a, &s, &p); + + switch ( s ) { + default: u3m_bail(c3__fail); + case c3__a: return _measure_array(p); + case c3__o: return _measure_object(p); + case c3__b: return _measure_loobean(p); + case c3__n: return _measure_number(p); + case c3__s: return _measure_string(p); + } + } +} + +static void +_serialize(json_buffer *buf_u, u3_noun a) +{ + if ( u3_nul == a ) { + _append_text(buf_u, _JSON_NULL, sizeof(_JSON_NULL) - 1); + } + else { + u3_noun s, p; + u3x_cell(a, &s, &p); + + switch ( s ) { + default: u3_assert(0); + case c3__a: _serialize_array(buf_u, p); break; + case c3__o: _serialize_object(buf_u, p); break; + case c3__b: _serialize_loobean(buf_u, p); break; + case c3__n: _serialize_number(buf_u, p); break; + case c3__s: _serialize_string(buf_u, p); break; + } + } +} + +/* +** jet interface functions +*/ + +u3_atom +u3qe_json_en(u3_noun a) +{ + u3i_slab sab_u; + json_buffer bof_u; + json_buffer *buf_u = &bof_u; + c3_w siz_w = _measure(a); + + u3i_slab_init(&sab_u, 3, siz_w); + buf_u->buf_y = sab_u.buf_y; + buf_u->len_w = 0; + + // note that it's structurally integral to call measure before serialize + _serialize(buf_u, a); + + return u3i_slab_mint_bytes(&sab_u); +} + +u3_atom +u3ke_json_en(u3_noun a) +{ + u3_atom res = u3qe_json_en(a); + u3z(a); + return res; +} + +u3_atom +u3we_json_en(u3_noun cor) +{ + return u3qe_json_en(u3x_at(u3x_sam, cor)); +} diff --git a/vere/pkg/noun/jets/e/keccak.c b/vere/pkg/noun/jets/e/keccak.c new file mode 100644 index 0000000..6149c55 --- /dev/null +++ b/vere/pkg/noun/jets/e/keccak.c @@ -0,0 +1,42 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + +#define defw(bits,byts) \ + u3_atom \ + _kecc_##bits(c3_w len_w, u3_atom a) \ + { \ + c3_y out[byts]; \ + c3_y* buf_y = u3r_bytes_alloc(0, len_w, a); \ + if ( 0 != urcrypt_keccak_##bits(buf_y, len_w, out) ) { \ + /* urcrypt_keccac_##bits always succeeds when called correctly */ \ + return u3m_bail(c3__oops); \ + } \ + else { \ + u3_atom pro = u3i_bytes(byts, out); \ + u3a_free(buf_y); \ + return pro; \ + } \ + } \ + \ + u3_weak \ + u3we_kecc##bits(u3_noun cor) \ + { \ + c3_w len_w; \ + u3_noun len, tom; \ + u3x_mean(cor, u3x_sam_2, &len, u3x_sam_3, &tom, 0); \ + return ( (c3n == u3ud(len)) || (c3n == u3ud(tom)) ) \ + ? u3m_bail(c3__exit) \ + : (!u3r_word_fit(&len_w, len)) \ + ? u3m_bail(c3__fail) \ + : _kecc_##bits(len_w, tom); \ + } + +defw(224, 28) +defw(256, 32) +defw(384, 48) +defw(512, 64) diff --git a/vere/pkg/noun/jets/e/leer.c b/vere/pkg/noun/jets/e/leer.c new file mode 100644 index 0000000..8ffe372 --- /dev/null +++ b/vere/pkg/noun/jets/e/leer.c @@ -0,0 +1,131 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +static u3_atom +_leer_cut(c3_w pos_w, c3_w len_w, u3_atom src) +{ + if ( 0 == len_w ) { + return 0; + } + else { + u3i_slab sab_u; + u3i_slab_bare(&sab_u, 3, len_w); + sab_u.buf_w[sab_u.len_w - 1] = 0; + + u3r_bytes(pos_w, len_w, sab_u.buf_y, src); + + return u3i_slab_mint_bytes(&sab_u); + } +} + +// Leaving the lore jet in place for backwards compatibility. +// TODO: remove u3[qw]e_lore (also from jet tree) + +u3_noun +u3qe_lore(u3_atom lub) +{ + c3_w len_w = u3r_met(3, lub); + c3_w pos_w = 0; + u3_noun tez = u3_nul; + + while ( 1 ) { + c3_w meg_w = 0; + c3_y end_y; + + c3_y byt_y; + while ( 1 ) { + if ( pos_w >= len_w ) { + byt_y = 0; + end_y = c3y; + break; + } + byt_y = u3r_byte(pos_w + meg_w, lub); + + if ( (10 == byt_y) || (0 == byt_y) ) { + end_y = __(byt_y == 0); + break; + } else meg_w++; + } + + if ((byt_y == 0) && ((pos_w + meg_w + 1) < len_w)) { + return u3m_bail(c3__exit); + } + + if ( !_(end_y) && pos_w >= len_w ) { + return u3kb_flop(tez); + } + else { + tez = u3nc(_leer_cut(pos_w, meg_w, lub), tez); + if ( _(end_y) ) { + return u3kb_flop(tez); + } + pos_w += (meg_w + 1); + } + } +} + +u3_noun +u3we_lore(u3_noun cor) +{ + u3_noun lub; + + if ( (u3_none == (lub = u3r_at(u3x_sam, cor))) || + (c3n == u3ud(lub)) ) + { + return u3m_bail(c3__fail); + } else { + return u3qe_lore(lub); + } +} + +u3_noun +u3qe_leer(u3_atom txt) +{ + u3_noun pro; + u3_noun* lit = &pro; + + { + c3_w pos_w, i_w = 0, len_w = u3r_met(3, txt); + u3_noun* hed; + u3_noun* tel; + + while ( i_w < len_w ) { + // scan till end or newline + // + for ( pos_w = i_w; i_w < len_w; ++i_w ) { + if ( 10 == u3r_byte(i_w, txt) ) { + break; + } + } + + // append to list + // + *lit = u3i_defcons(&hed, &tel); + *hed = _leer_cut(pos_w, i_w - pos_w, txt); + lit = tel; + + i_w++; + } + } + + *lit = u3_nul; + + return pro; +} + +u3_noun +u3we_leer(u3_noun cor) +{ + u3_noun txt = u3x_at(u3x_sam, cor); + + if ( c3n == u3ud(txt) ) { + return u3m_bail(c3__fail); + } + + return u3qe_leer(txt); +} diff --git a/vere/pkg/noun/jets/e/loss.c b/vere/pkg/noun/jets/e/loss.c new file mode 100644 index 0000000..35cdc4e --- /dev/null +++ b/vere/pkg/noun/jets/e/loss.c @@ -0,0 +1,297 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + typedef struct _u3_loss { // loss problem + u3_noun hel; // a as a list + c3_w lel_w; // length of a + c3_w lev_w; // length of b + u3_noun* hev; // b as an array + u3_noun sev; // b as a set of lists + c3_w kct_w; // candidate count + u3_noun* kad; // candidate array + } u3_loss; + + // free loss object + // + static void + _flem(u3_loss* loc_u) + { + u3z(loc_u->sev); + { + c3_w i_w; + + for ( i_w = 0; i_w < loc_u->kct_w; i_w++ ) { + u3z(loc_u->kad[i_w]); + } + } + u3a_free(loc_u->hev); + u3a_free(loc_u->kad); + } + + // extract lcs - XX don't use the stack like this + // + static u3_noun + _lext(u3_loss* loc_u, + u3_noun kad) + { + if ( u3_nul == kad ) { + return u3_nul; + } else { + return u3nc(u3k(loc_u->hev[u3r_word(0, u3h(kad))]), + _lext(loc_u, u3t(kad))); + } + } + + // extract lcs + // + static u3_noun + _lexs(u3_loss* loc_u) + { + if ( 0 == loc_u->kct_w ) { + return u3_nul; + } else return u3kb_flop(_lext(loc_u, loc_u->kad[loc_u->kct_w - 1])); + } + + // initialize loss object + // + static void + _lemp(u3_loss* loc_u, + u3_noun hel, + u3_noun hev) + { + loc_u->hel = hel; + loc_u->lel_w = u3kb_lent(u3k(hel)); + + // Read hev into array. + { + c3_w i_w; + + loc_u->hev = u3a_malloc(u3kb_lent(u3k(hev)) * sizeof(u3_noun)); + + for ( i_w = 0; u3_nul != hev; i_w++ ) { + loc_u->hev[i_w] = u3h(hev); + hev = u3t(hev); + } + loc_u->lev_w = i_w; + } + loc_u->kct_w = 0; + loc_u->kad = u3a_malloc((1 + c3_min(loc_u->lev_w, loc_u->lel_w)) * + sizeof(u3_noun)); + + // Compute equivalence classes. + // + loc_u->sev = u3_nul; + { + c3_w i_w; + + for ( i_w = 0; i_w < loc_u->lev_w; i_w++ ) { + u3_noun how = loc_u->hev[i_w]; + u3_noun hav; + u3_noun teg; + + hav = u3kdb_get(u3k(loc_u->sev), u3k(how)); + teg = u3nc(u3i_words(1, &i_w), + (hav == u3_none) ? u3_nul : hav); + loc_u->sev = u3kdb_put(loc_u->sev, u3k(how), teg); + } + } + } + + // apply + // + static void + _lune(u3_loss* loc_u, + c3_w inx_w, + c3_w goy_w) + { + u3_noun kad; + + kad = u3nc(u3i_words(1, &goy_w), + (inx_w == 0) ? u3_nul + : u3k(loc_u->kad[inx_w - 1])); + if ( loc_u->kct_w == inx_w ) { + u3_assert(loc_u->kct_w < (1 << 31)); + loc_u->kct_w++; + } else { + u3z(loc_u->kad[inx_w]); + } + loc_u->kad[inx_w] = kad; + } + + // extend fits top + // + static u3_noun + _hink(u3_loss* loc_u, + c3_w inx_w, + c3_w goy_w) + { + return __ + ( (loc_u->kct_w == inx_w) || + (u3r_word(0, u3h(loc_u->kad[inx_w])) > goy_w) ); + } + + // extend fits bottom + // + static u3_noun + _lonk(u3_loss* loc_u, + c3_w inx_w, + c3_w goy_w) + { + return __ + ( (0 == inx_w) || + (u3r_word(0, u3h(loc_u->kad[inx_w - 1])) < goy_w) ); + } + +#if 0 + // search for first index >= inx_w and <= max_w that fits + // the hink and lonk criteria. + // + static u3_noun + _binka(u3_loss* loc_u, + c3_w* inx_w, + c3_w max_w, + c3_w goy_w) + { + while ( *inx_w <= max_w ) { + if ( c3n == _lonk(loc_u, *inx_w, goy_w) ) { + return c3n; + } + if ( c3y == _hink(loc_u, *inx_w, goy_w) ) { + return c3y; + } + else ++*inx_w; + } + return c3n; + } +#endif + + // search for lowest index >= inx_w and <= max_w for which + // both hink(inx_w) and lonk(inx_w) are true. lonk is false + // if inx_w is too high, hink is false if it is too low. + // + static u3_noun + _bink(u3_loss* loc_u, + c3_w* inx_w, + c3_w max_w, + c3_w goy_w) + { + u3_assert(max_w >= *inx_w); + + if ( max_w == *inx_w ) { + if ( c3n == _lonk(loc_u, *inx_w, goy_w) ) { + return c3n; + } + if ( c3y == _hink(loc_u, *inx_w, goy_w) ) { + return c3y; + } + else { + ++*inx_w; + return c3n; + } + } + else { + c3_w mid_w = *inx_w + ((max_w - *inx_w) / 2); + + if ( (c3n == _lonk(loc_u, mid_w, goy_w)) || + (c3y == _hink(loc_u, mid_w, goy_w)) ) + { + return _bink(loc_u, inx_w, mid_w, goy_w); + } else { + *inx_w = mid_w + 1; + return _bink(loc_u, inx_w, max_w, goy_w); + } + } + } + + + static void + _merg(u3_loss* loc_u, + c3_w inx_w, + u3_noun gay) + { + if ( (u3_nul == gay) || (inx_w > loc_u->kct_w) ) { + return; + } + else { + u3_noun i_gay = u3h(gay); + c3_w goy_w = u3r_word(0, i_gay); + u3_noun bik; + + bik = _bink(loc_u, &inx_w, loc_u->kct_w, goy_w); + + if ( c3y == bik ) { + _merg(loc_u, inx_w + 1, u3t(gay)); + _lune(loc_u, inx_w, goy_w); + } + else { + _merg(loc_u, inx_w, u3t(gay)); + } + } + } + + // compute lcs + // + static void + _loss(u3_loss* loc_u) + { + while ( u3_nul != loc_u->hel ) { + u3_noun i_hel = u3h(loc_u->hel); + u3_noun guy = u3kdb_get(u3k(loc_u->sev), u3k(i_hel)); + + if ( u3_none != guy ) { + u3_noun gay = u3kb_flop(guy); + + _merg(loc_u, 0, gay); + u3z(gay); + } + + loc_u->hel = u3t(loc_u->hel); + } + } + + u3_noun + u3qe_loss(u3_noun hel, + u3_noun hev) + { + u3_loss loc_u; + u3_noun lcs; + + _lemp(&loc_u, hel, hev); + _loss(&loc_u); + lcs = _lexs(&loc_u); + + _flem(&loc_u); + return lcs; + } + + static u3_noun + _listp(u3_noun lix) + { + while ( 1 ) { + if ( u3_nul == lix ) return c3y; + if ( c3n == u3du(lix) ) return c3n; + lix = u3t(lix); + } + } + + u3_noun + u3we_loss(u3_noun cor) + { + u3_noun hel, hev; + + if ( (u3_none == (hel = u3r_at(u3x_sam_2, cor))) || + (u3_none == (hev = u3r_at(u3x_sam_3, cor))) || + (c3n == _listp(hel)) || + (c3n == _listp(hev)) ) + { + return u3m_bail(c3__fail); + } else { + return u3qe_loss(hel, hev); + } + } diff --git a/vere/pkg/noun/jets/e/lune.c b/vere/pkg/noun/jets/e/lune.c new file mode 100644 index 0000000..1187073 --- /dev/null +++ b/vere/pkg/noun/jets/e/lune.c @@ -0,0 +1,57 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qe_lune(u3_atom lub) + { + if (lub == 0) { + return u3_nul; + } + + { + c3_w end_w = u3r_met(3, lub) - 1; + c3_w pos_w = end_w; + u3_noun lin = u3_nul; + + if (u3r_byte(pos_w, lub) != 10) { + return u3m_error("noeol"); + } + + if (pos_w == 0) { + return u3nc(u3_nul, lin); + } + + while (--pos_w) { + if (u3r_byte(pos_w, lub) == 10) { + lin = u3nc(u3qc_cut(3, (pos_w + 1), (end_w - pos_w - 1), lub), lin); + end_w = pos_w; + } + } + + if (u3r_byte(pos_w, lub) == 10) { + return u3nc(u3_nul, + u3nc(u3qc_cut(3, (pos_w + 1), (end_w - pos_w - 1), lub), lin)); + } + + return u3nc(u3qc_cut(3, pos_w, (end_w - pos_w), lub), lin); + } + } + + u3_noun + u3we_lune(u3_noun cor) + { + u3_noun lub; + + if ( (u3_none == (lub = u3r_at(u3x_sam, cor))) || + (c3n == u3ud(lub)) ) + { + return u3m_bail(c3__fail); + } else { + return u3qe_lune(lub); + } + } diff --git a/vere/pkg/noun/jets/e/mat.c b/vere/pkg/noun/jets/e/mat.c new file mode 100644 index 0000000..89de386 --- /dev/null +++ b/vere/pkg/noun/jets/e/mat.c @@ -0,0 +1,49 @@ + /// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + u3_noun + u3qe_mat(u3_atom a) + { + if ( 0 == a ) { + return u3nc(1, 1); + } else { + u3_atom b = u3qc_met(0, a); + u3_atom c = u3qc_met(0, b); + u3_atom u, v, w, x, y, z; + u3_atom p, q; + + u = u3qa_dec(c); + v = u3qa_add(c, c); + w = u3qc_bex(c); + x = u3qc_end(0, u, b); + y = u3qc_lsh(0, u, a); + z = u3qc_mix(x, y); + + p = u3qa_add(v, b); + q = u3qc_cat(0, w, z); + + u3z(u); + u3z(v); + u3z(w); + u3z(x); + u3z(y); + u3z(z); + + return u3nc(p, q); + } + } + u3_noun + u3we_mat(u3_noun cor) + { + u3_noun a; + + if ( (u3_none == (a = u3r_at(u3x_sam, cor))) ) { + return u3m_bail(c3__fail); + } else { + return u3qe_mat(a); + } + } diff --git a/vere/pkg/noun/jets/e/mice.c b/vere/pkg/noun/jets/e/mice.c new file mode 100644 index 0000000..81b4a33 --- /dev/null +++ b/vere/pkg/noun/jets/e/mice.c @@ -0,0 +1,23 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +/* variant of u3we_mink() / u3m_soft_run(). caching, no scry. +*/ +u3_noun +u3we_mice(u3_noun cor) { + u3_noun bus, fol; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &bus, + u3x_sam_3, &fol, + 0) ) + { + return u3m_bail(c3__exit); + } + else { + return u3m_soft_cax(u3n_nock_on, u3k(bus), u3k(fol)); + } +} diff --git a/vere/pkg/noun/jets/e/mink.c b/vere/pkg/noun/jets/e/mink.c new file mode 100644 index 0000000..4caa208 --- /dev/null +++ b/vere/pkg/noun/jets/e/mink.c @@ -0,0 +1,27 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + u3_noun + u3we_mink(u3_noun cor) + { + u3_noun bus, fol, gul; + + if ( c3n == u3r_mean(cor, u3x_sam_4, &bus, + u3x_sam_5, &fol, + u3x_sam_3, &gul, + 0) ) + { + return u3m_bail(c3__exit); + } + else { + u3_noun som; + + som = u3n_nock_et(u3k(gul), u3k(bus), u3k(fol)); + + return som; + } + } diff --git a/vere/pkg/noun/jets/e/mole.c b/vere/pkg/noun/jets/e/mole.c new file mode 100644 index 0000000..a318390 --- /dev/null +++ b/vere/pkg/noun/jets/e/mole.c @@ -0,0 +1,18 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3we_mole(u3_noun cor) +{ + u3_noun hok = u3j_cook("u3we_mole-mure", u3k(cor), "mure"); + + // just like +mule and +mute, this takes advantage of the fact that + // +mure's result is identical to that of +mole, and safely produces + // a statically-typed value while only evaluating the trap once. + // + return u3n_slam_on(hok, u3k(u3x_at(u3x_sam, cor))); +} diff --git a/vere/pkg/noun/jets/e/mule.c b/vere/pkg/noun/jets/e/mule.c new file mode 100644 index 0000000..79e4656 --- /dev/null +++ b/vere/pkg/noun/jets/e/mule.c @@ -0,0 +1,19 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3we_mule(u3_noun cor) +{ + u3_noun hok = u3j_cook("u3we_mule-mute", u3k(cor), "mute"); + + + // this takes advantage of the fact that +mute's result is + // identical to that of +mule, and safely produces a statically-typed + // value while only evaluating the trap once. + // + return u3n_slam_on(hok, u3k(u3x_at(u3x_sam, cor))); +} diff --git a/vere/pkg/noun/jets/e/parse.c b/vere/pkg/noun/jets/e/parse.c new file mode 100644 index 0000000..4ae8ab0 --- /dev/null +++ b/vere/pkg/noun/jets/e/parse.c @@ -0,0 +1,1052 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + // get p.u.q.vex from an $edge, assumes that the unit is non-empty + // RETAIN [vex] + // + static inline u3_noun + _puq(u3_noun vex) + { + u3_weak pro = u3r_at(14, vex); + c3_dessert(u3_none != pro); + return (u3_noun)pro; + } + + // get q.u.q.vex from an $edge, assumes that the unit is non-empty + // RETAIN [vex] + // + static inline u3_noun + _quq(u3_noun vex) + { + u3_weak pro = u3r_at(15, vex); + c3_dessert(u3_none != pro); + return (u3_noun)pro; + } + + #define _p u3h + #define _q u3t + + static u3_noun + _slip(u3_noun weq, + u3_noun naz) + { + u3_noun p_naz, q_naz; + + u3x_cell(naz, &p_naz, &q_naz); + if ( 10 == weq ) { + return u3nc(u3i_vint(u3k(p_naz)), 1); + } else { + return u3nc(u3k(p_naz), u3i_vint(u3k(q_naz))); + } + } + + static u3_noun + _fail(u3_noun tub) + { + u3_noun p_tub, q_tub; + + u3x_cell(tub, &p_tub, &q_tub); + return u3nc(u3k(p_tub), u3_nul); + } + + static u3_noun + _last(u3_noun zyc, + u3_noun naz) + { + u3_noun p_zyc, q_zyc, p_naz, q_naz; + + u3x_cell(zyc, &p_zyc, &q_zyc); + u3x_cell(naz, &p_naz, &q_naz); + + if ( !_(u3a_is_cat(p_zyc)) || !_(u3a_is_cat(q_zyc)) || + !_(u3a_is_cat(p_naz)) || !_(u3a_is_cat(q_naz)) ) + { + return u3m_bail(c3__fail); + } else { + if ( p_zyc == p_naz ) { + return (q_zyc > q_naz) ? u3k(zyc) : u3k(naz); + } + else { + return (p_zyc > p_naz) ? u3k(zyc) : u3k(naz); + } + } + } + + static u3_noun + _last_k(u3_noun zyc, u3_noun naz) + { + u3_noun pro = _last(zyc, naz); + u3z(zyc); u3z(naz); + return pro; + } + + static u3_noun + _next(u3_noun tub) + { + u3_noun p_tub, q_tub; + u3_noun zac; + + u3x_cell(tub, &p_tub, &q_tub); + if ( c3n == u3du(q_tub) ) { + return _fail(tub); + } + else { + u3_noun iq_tub = u3h(q_tub); + u3_noun tq_tub = u3t(q_tub); + + zac = _slip(iq_tub, p_tub); + + return u3nc(zac, + u3nq(u3_nul, + u3k(iq_tub), + u3k(zac), + u3k(tq_tub))); + } + } + +/* bend +*/ + static u3_noun + _cqe_bend_fun(u3_noun raq, + u3_noun vex, + u3_noun sab) + { + u3_noun p_vex, q_vex; + + u3x_cell(vex, &p_vex, &q_vex); + if ( c3n == u3du(q_vex) ) { + return u3k(vex); + } else { + u3_noun uq_vex = u3t(q_vex); + u3_noun quq_vex; + u3_noun yit, yur; + u3_noun p_yit, q_yit; + u3_noun ret; + + quq_vex = u3t(uq_vex); + + yit = u3n_slam_on(u3k(sab), u3k(quq_vex)); + + u3x_cell(yit, &p_yit, &q_yit); + yur = _last(_p(vex), p_yit); + + if ( c3n == u3du(q_yit) ) { + ret = u3nc(yur, u3k(q_vex)); + } + else { + u3_noun uq_yit = u3t(q_yit); + u3_noun puq_yit; + u3_noun vux; + + puq_yit = u3h(uq_yit); + + vux = u3n_slam_on(u3k(raq), + u3nc(u3k(_puq(vex)), + u3k(puq_yit))); + if ( u3_nul == vux ) { + ret = u3nc(yur, u3k(_q(vex))); + } + else { + ret = u3nq(yur, + u3_nul, + u3k(u3t(vux)), + u3k(_quq(yit))); + u3z(vux); + } + } + u3z(yit); + return ret; + } + } + + u3_noun + u3we_bend_fun(u3_noun cor) + { + u3_noun van, raq, vex, sab; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &vex, + u3x_sam_3, &sab, + u3x_con, &van, 0)) || + (u3_none == (raq = u3r_at(u3x_sam, van))) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_bend_fun(raq, vex, sab); + } + } + +/* cold +*/ + static u3_noun + _cqe_cold_fun(u3_noun cus, + u3_noun sef, + u3_noun tub) + { + u3_noun vex = u3n_slam_on(u3k(sef), u3k(tub)); + u3_noun p_vex, q_vex; + + u3x_cell(vex, &p_vex, &q_vex); + + if ( c3n == u3du(q_vex) ) { + return vex; + } + else { + u3_noun uq_vex = u3t(q_vex); + u3_noun quq_vex; + u3_noun ret; + + u3x_cell(uq_vex, 0, &quq_vex); + ret = u3nq(u3k(p_vex), + u3_nul, + u3k(cus), + u3k(quq_vex)); + + u3z(vex); + return ret; + } + } + + u3_noun + u3we_cold_fun(u3_noun cor) + { + u3_noun van, cus, sef, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &van, 0)) || + (c3n == u3r_mean(van, u3x_sam_2, &cus, u3x_sam_3, &sef, 0)) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_cold_fun(cus, sef, tub); + } + } + +/* cook +*/ + static u3_noun + _cqe_cook_fun(u3_noun poq, + u3_noun sef, + u3_noun tub) + { + u3_noun vex = u3n_slam_on(u3k(sef), u3k(tub)); + u3_noun p_vex, q_vex; + + u3x_cell(vex, &p_vex, &q_vex); + + if ( c3n == u3du(q_vex) ) { + return vex; + } + else { + u3_noun uq_vex = u3t(q_vex); + u3_noun puq_vex, quq_vex; + u3_noun wag; + u3_noun ret; + + u3x_cell(uq_vex, &puq_vex, &quq_vex); + + u3k(quq_vex); + u3k(p_vex); + wag = u3n_slam_on(u3k(poq), u3k(puq_vex)); + + ret = u3nq(p_vex, + u3_nul, + wag, + quq_vex); + + u3z(vex); + return ret; + } + } + + u3_noun + u3we_cook_fun(u3_noun cor) + { + u3_noun van, poq, sef, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &van, 0)) || + (c3n == u3r_mean(van, u3x_sam_2, &poq, u3x_sam_3, &sef, 0)) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_cook_fun(poq, sef, tub); + } + } + +/* comp +*/ + static u3_noun + _cqe_comp_fun(u3_noun raq, + u3_noun vex, + u3_noun sab) + { + u3_noun p_vex, q_vex; + + u3x_cell(vex, &p_vex, &q_vex); + if ( c3n == u3du(q_vex) ) { + return u3k(vex); + } else { + u3_noun uq_vex = u3t(q_vex); + u3_noun puq_vex, quq_vex; + u3_noun yit, yur; + u3_noun p_yit, q_yit; + u3_noun ret; + + u3x_cell(uq_vex, &puq_vex, &quq_vex); + yit = u3n_slam_on(u3k(sab), u3k(quq_vex)); + + u3x_cell(yit, &p_yit, &q_yit); + yur = _last(_p(vex), p_yit); + + if ( c3n == u3du(q_yit) ) { + ret = u3nc(yur, u3k(q_yit)); + } + else { + u3_noun uq_yit = u3t(q_yit); + u3_noun puq_yit, quq_yit; + + u3x_cell(uq_yit, &puq_yit, &quq_yit); + + u3k(quq_yit); + ret = u3nq(yur, + u3_nul, + u3n_slam_on(u3k(raq), + u3nc(u3k(_puq(vex)), + u3k(puq_yit))), + quq_yit); + } + u3z(yit); + return ret; + } + } + + u3_noun + u3we_comp_fun(u3_noun cor) + { + u3_noun van, raq, vex, sab; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &vex, + u3x_sam_3, &sab, + u3x_con, &van, 0)) || + (u3_none == (raq = u3r_at(u3x_sam, van))) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_comp_fun(raq, vex, sab); + } + } + +/* easy +*/ + static u3_noun + _cqe_easy_fun(u3_noun huf, + u3_noun tub) + { + u3_noun p_tub, q_tub; + + u3x_cell(tub, &p_tub, &q_tub); + return u3nq(u3k(p_tub), + u3_nul, + u3k(huf), + u3k(tub)); + } + + u3_noun + u3we_easy_fun(u3_noun cor) + { + u3_noun van, huf, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &van, 0)) || + (u3_none == (huf = u3r_at(u3x_sam, van))) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_easy_fun(huf, tub); + } + } + +/* glue +*/ + static u3_noun + _cqe_glue_fun(u3_noun bus, + u3_noun vex, + u3_noun sab) + { + u3_noun p_vex, q_vex; + + u3x_cell(vex, &p_vex, &q_vex); + if ( c3n == u3du(q_vex) ) { + return u3k(vex); + } + else { + u3_noun uq_vex = u3t(q_vex); + u3_noun puq_vex, quq_vex; + u3_noun yit, yur; + u3_noun p_yit, q_yit; + u3_noun ret; + + u3x_cell(uq_vex, &puq_vex, &quq_vex); + yit = u3n_slam_on(u3k(bus), u3k(quq_vex)); + + u3x_cell(yit, &p_yit, &q_yit); + yur = _last(_p(vex), p_yit); + + if ( c3n == u3du(q_yit) ) { + ret = u3nc(yur, u3_nul); + } + else { + u3_noun uq_yit = u3t(q_yit); + u3_noun puq_yit, quq_yit; + u3_noun wam, p_wam, q_wam, goy; + + u3x_cell(uq_yit, &puq_yit, &quq_yit); + wam = u3n_slam_on(u3k(sab), u3k(quq_yit)); + + u3x_cell(wam, &p_wam, &q_wam); + goy = _last(yur, p_wam); + u3z(yur); + + if ( c3n == u3du(q_wam) ) { + ret = u3nc(goy, u3_nul); + } else { + u3_noun uq_wam = u3t(q_wam); + u3_noun puq_wam, quq_wam; + + u3x_cell(uq_wam, &puq_wam, &quq_wam); + ret = u3nq(goy, + u3_nul, + u3nc(u3k(_puq(vex)), + u3k(puq_wam)), + u3k(quq_wam)); + } + u3z(wam); + } + u3z(yit); + return ret; + } + } + + u3_noun + u3we_glue_fun(u3_noun cor) + { + u3_noun van, bus, vex, sab; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &vex, + u3x_sam_3, &sab, + u3x_con, &van, 0)) || + (u3_none == (bus = u3r_at(u3x_sam, van))) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_glue_fun(bus, vex, sab); + } + } + +/* here +*/ + static u3_noun + _cqe_here_fun(u3_noun hez, + u3_noun sef, + u3_noun tub) + { + u3_noun vex = u3n_slam_on(u3k(sef), u3k(tub)); + u3_noun p_vex, q_vex; + + u3x_cell(vex, &p_vex, &q_vex); + + if ( c3n == u3du(q_vex) ) { + return vex; + } + else { + u3_noun uq_vex = u3t(q_vex); + u3_noun p_tub, q_tub; + u3_noun puq_vex, quq_vex, pquq_vex; + u3_noun gud, wag; + u3_noun ret; + + u3x_cell(tub, &p_tub, &q_tub); + u3x_cell(uq_vex, &puq_vex, &quq_vex); + u3x_cell(quq_vex, &pquq_vex, 0); + gud = u3nc( + u3nc(u3k(p_tub), + u3k(pquq_vex)), + u3k(puq_vex)); + + u3k(p_vex); + u3k(quq_vex); + wag = u3n_slam_on(u3k(hez), gud); + ret = u3nq(p_vex, + u3_nul, + wag, + quq_vex); + + u3z(vex); + return ret; + } + } + + u3_noun + u3we_here_fun(u3_noun cor) + { + u3_noun van, hez, sef, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &van, 0)) || + (c3n == u3r_mean(van, u3x_sam_2, &hez, u3x_sam_3, &sef, 0)) ) + { + return u3m_bail(c3__fail); + } + else { + return _cqe_here_fun(hez, sef, tub); + } + } + +/* just +*/ + static u3_noun + _cqe_just_fun(u3_noun daf, + u3_noun tub) + { + u3_noun p_tub, q_tub; + + u3x_cell(tub, &p_tub, &q_tub); + + if ( c3n == u3du(q_tub) ) { + return _fail(tub); + } + else { + u3_noun iq_tub = u3h(q_tub); + + if ( c3y == u3r_sing(daf, iq_tub) ) { + return _next(tub); + } + else return _fail(tub); + } + } + u3_noun + u3we_just_fun(u3_noun cor) + { + u3_noun van, daf, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &van, 0)) || + (u3_none == (daf = u3r_at(u3x_sam, van))) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_just_fun(daf, tub); + } + } + +/* mask +*/ + static u3_noun + _cqe_mask_fun(u3_noun bud, + u3_noun tub) + { + u3_noun p_tub, q_tub; + + u3x_cell(tub, &p_tub, &q_tub); + + if ( c3n == u3du(q_tub) ) { + return _fail(tub); + } + else { + u3_noun iq_tub = u3h(q_tub); + + while ( c3y == u3du(bud) ) { + if ( c3y == u3r_sing(u3h(bud), iq_tub) ) { + return _next(tub); + } + bud = u3t(bud); + } + return _fail(tub); + } + } + u3_noun + u3we_mask_fun(u3_noun cor) + { + u3_noun van, bud, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &van, 0)) || + (u3_none == (bud = u3r_at(u3x_sam, van))) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_mask_fun(bud, tub); + } + } +/* pfix +*/ + static u3_noun + _cqe_pfix(u3_noun vex, + u3_noun sab) + { + u3_noun q_vex; + + q_vex = u3t(vex); + if ( c3n == u3du(q_vex) ) { + return u3k(vex); + } + else { + u3_noun uq_vex = u3t(q_vex); + u3_noun quq_vex; + u3_noun yit, p_yit, q_yit; + u3_noun ret; + + quq_vex = u3t(uq_vex); + + yit = u3n_slam_on(u3k(sab), u3k(quq_vex)); + + u3x_cell(yit, &p_yit, &q_yit); + ret = u3nc(_last(_p(vex), p_yit), + u3k(q_yit)); + + u3z(yit); + return ret; + } + } + u3_noun + u3we_pfix(u3_noun cor) + { + u3_noun vex, sab; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &vex, u3x_sam_3, &sab, 0)) ) { + return u3m_bail(c3__exit); + } else { + return _cqe_pfix(vex, sab); + } + } + +/* plug +*/ + static u3_noun + _cqe_plug(u3_noun vex, + u3_noun sab) + { + u3_noun p_vex, q_vex; + + u3x_cell(vex, &p_vex, &q_vex); + if ( c3n == u3du(q_vex) ) { + return u3k(vex); + } + else { + u3_noun uq_vex = u3t(q_vex); + u3_noun puq_vex, quq_vex; + u3_noun yit, yur; + u3_noun p_yit, q_yit; + u3_noun ret; + + u3x_cell(uq_vex, &puq_vex, &quq_vex); + yit = u3n_slam_on(u3k(sab), u3k(quq_vex)); + + u3x_cell(yit, &p_yit, &q_yit); + yur = _last(_p(vex), p_yit); + + if ( c3n == u3du(q_yit) ) { + ret = u3nc(yur, u3k(q_yit)); + } + else { + u3_noun uq_yit = u3t(q_yit); + u3_noun puq_yit, quq_yit; + + u3x_cell(uq_yit, &puq_yit, &quq_yit); + ret = u3nq(yur, + u3_nul, + u3nc(u3k(_puq(vex)), + u3k(puq_yit)), + u3k(quq_yit)); + } + u3z(yit); + return ret; + } + } + u3_noun + u3we_plug(u3_noun cor) + { + u3_noun vex, sab; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &vex, u3x_sam_3, &sab, 0)) ) { + return u3m_bail(c3__exit); + } else { + return _cqe_plug(vex, sab); + } + } + +/* pose +*/ + u3_noun + u3qe_pose(u3_noun vex, + u3_noun sab) + { + u3_noun q_vex; + + q_vex = u3t(vex); + if ( c3y == u3du(q_vex) ) { + return u3k(vex); + } else { + u3_noun roq = u3n_kick_on(u3k(sab)); + u3_noun p_roq, q_roq; + u3_noun ret; + + u3x_cell(roq, &p_roq, &q_roq); + ret = u3nc(_last(_p(vex), p_roq), + u3k(q_roq)); + + u3z(roq); + return ret; + } + } + u3_noun + u3we_pose(u3_noun cor) + { + u3_noun vex, sab; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &vex, u3x_sam_3, &sab, 0)) ) { + return u3m_bail(c3__exit); + } else { + return u3qe_pose(vex, sab); + } + } + +/* sfix +*/ + static u3_noun + _cqe_sfix(u3_noun vex, + u3_noun sab) + { + u3_noun q_vex; + + q_vex = u3t(vex); + if ( c3n == u3du(q_vex) ) { + return u3k(vex); + } + else { + u3_noun uq_vex = u3t(q_vex); + u3_noun quq_vex; + u3_noun yit, p_yit, q_yit, yur; + u3_noun ret; + + quq_vex = u3t(uq_vex); + + yit = u3n_slam_on(u3k(sab), u3k(quq_vex)); + + u3x_cell(yit, &p_yit, &q_yit); + yur = _last(_p(vex), p_yit); + + if ( c3n == u3du(q_yit) ) { + ret = u3nc(yur, u3_nul); + } + else { + u3_noun uq_yit = u3t(q_yit); + u3_noun puq_yit, quq_yit; + + u3x_cell(uq_yit, &puq_yit, &quq_yit); + + ret = u3nq(yur, + u3_nul, + u3k(_puq(vex)), + u3k(quq_yit)); + } + u3z(yit); + return ret; + } + } + u3_noun + u3we_sfix(u3_noun cor) + { + u3_noun vex, sab; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &vex, u3x_sam_3, &sab, 0)) ) { + return u3m_bail(c3__exit); + } else { + return _cqe_sfix(vex, sab); + } + } + +/* shim +*/ + static u3_noun + _cqe_shim_fun(u3_noun zep, + u3_noun tub) + { + u3_noun p_tub, q_tub; + + u3x_cell(tub, &p_tub, &q_tub); + + if ( c3n == u3du(q_tub) ) { + return _fail(tub); + } + else { + u3_noun p_zep, q_zep; + u3_noun iq_tub = u3h(q_tub); + + u3x_cell(zep, &p_zep, &q_zep); + if ( _(u3a_is_cat(p_zep)) && + _(u3a_is_cat(q_zep)) && + _(u3a_is_cat(iq_tub)) ) + { + if ( (iq_tub >= p_zep) && (iq_tub <= q_zep) ) { + return _next(tub); + } + else return _fail(tub); + } + else { + return u3m_bail(c3__fail); + } + } + } + u3_noun + u3we_shim_fun(u3_noun cor) + { + u3_noun van, zep, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &van, 0)) || + (u3_none == (zep = u3r_at(u3x_sam, van))) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_shim_fun(zep, tub); + } + } + +/* stag +*/ + static u3_noun + _cqe_stag_fun(u3_noun gob, + u3_noun sef, + u3_noun tub) + { + u3_noun vex = u3n_slam_on(u3k(sef), u3k(tub)); + u3_noun p_vex, q_vex; + + u3x_cell(vex, &p_vex, &q_vex); + + if ( c3n == u3du(q_vex) ) { + return vex; + } + else { + u3_noun uq_vex = u3t(q_vex); + u3_noun puq_vex, quq_vex; + u3_noun wag; + u3_noun ret; + + u3x_cell(uq_vex, &puq_vex, &quq_vex); + wag = u3nc(u3k(gob), u3k(puq_vex)); + ret = u3nq(u3k(p_vex), + u3_nul, + wag, + u3k(quq_vex)); + + u3z(vex); + return ret; + } + } + + u3_noun + u3we_stag_fun(u3_noun cor) + { + u3_noun van, gob, sef, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &van, 0)) || + (c3n == u3r_mean(van, u3x_sam_2, &gob, u3x_sam_3, &sef, 0)) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_stag_fun(gob, sef, tub); + } + } + +/* stew +*/ + static u3_noun + _stew_wor(u3_noun ort, + u3_noun wan) + { + if ( !_(u3a_is_cat(ort)) ) { + return u3m_bail(c3__fail); + } + else { + if ( c3n == u3du(wan) ) { + if ( !_(u3a_is_cat(wan)) ) { + return u3m_bail(c3__fail); + } + else return (ort < wan) ? c3y : c3n; + } + else { + u3_noun h_wan = u3h(wan); + + if ( !_(u3a_is_cat(h_wan)) ) { + return u3m_bail(c3__fail); + } + else return (ort < h_wan) ? c3y : c3n; + } + } + } + + static u3_noun + _cqe_stew_fun(u3_noun hel, + u3_noun tub) + { + u3_noun p_tub, q_tub; + + u3x_cell(tub, &p_tub, &q_tub); + if ( c3n == u3du(q_tub) ) { + return _fail(tub); + } + else { + u3_noun iq_tub = u3h(q_tub); + + if ( !_(u3a_is_cat(iq_tub)) ) { + return u3m_bail(c3__fail); + } + else while ( 1 ) { + if ( c3n == u3du(hel) ) { + return _fail(tub); + } + else { + u3_noun n_hel, l_hel, r_hel; + u3_noun pn_hel, qn_hel; + c3_o bit_o; + + u3x_trel(hel, &n_hel, &l_hel, &r_hel); + u3x_cell(n_hel, &pn_hel, &qn_hel); + + if ( (c3n == u3du(pn_hel)) ) { + bit_o = __((iq_tub == pn_hel)); + } + else { + u3_noun hpn_hel = u3h(pn_hel); + u3_noun tpn_hel = u3t(pn_hel); + + if ( !_(u3a_is_cat(hpn_hel)) || + !_(u3a_is_cat(tpn_hel)) ) { + return _fail(tub); + } + else bit_o = __((iq_tub >= hpn_hel) && (iq_tub <= tpn_hel)); + } + + if ( c3y == bit_o ) { + return u3n_slam_on(u3k(qn_hel), u3k(tub)); + } else { + if ( c3y == _stew_wor(iq_tub, pn_hel) ) { + hel = l_hel; + } + else hel = r_hel; + } + } + } + } + } + u3_noun + u3we_stew_fun(u3_noun cor) + { + u3_noun con, hel, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &con, 0)) || + (u3_none == (hel = u3r_at(2, con))) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_stew_fun(hel, tub); + } + } + +/* _stir_pair(): stack frame recording intermediate parse results +*/ + typedef struct { + u3_noun har; // hair, p_vex + u3_noun res; // parse-result, puq_vex + } _stir_pair; + +/* stir +*/ + static u3_noun + _cqe_stir_fun(u3_noun rud, + u3_noun raq, + u3_noun fel, + u3_noun tub) + { + // pil_u: stack control structure + // par_u: frame pointer + // wag: initial accumulator (deconstructed) + // + u3a_pile pil_u; + _stir_pair* par_u; + u3_noun p_wag, puq_wag, quq_wag; + + u3a_pile_prep(&pil_u, sizeof(*par_u)); + + // push incremental, successful [fel] parse results onto road stack + // + { + u3_noun vex, p_vex, q_vex, puq_vex, quq_vex; + u3j_site fel_u; + u3j_gate_prep(&fel_u, u3k(fel)); + + vex = u3j_gate_slam(&fel_u, u3k(tub)); + u3x_cell(vex, &p_vex, &q_vex); + + u3k(tub); + + while ( u3_nul != q_vex ) { + u3x_trel(q_vex, 0, &puq_vex, &quq_vex); + + par_u = u3a_push(&pil_u); + par_u->har = u3k(p_vex); + par_u->res = u3k(puq_vex); + + u3z(tub); + tub = u3k(quq_vex); + + u3z(vex); + vex = u3j_gate_slam(&fel_u, u3k(tub)); + u3x_cell(vex, &p_vex, &q_vex); + } + + p_wag = u3k(p_vex); + puq_wag = u3k(rud); + quq_wag = tub; + + u3z(vex); + u3j_gate_lose(&fel_u); + } + + // unwind the stack, folding parse results into [wag] by way of [raq] + // + if ( c3n == u3a_pile_done(&pil_u) ) { + u3j_site raq_u; + u3j_gate_prep(&raq_u, u3k(raq)); + + while ( c3n == u3a_pile_done(&pil_u) ) { + p_wag = _last_k(par_u->har, p_wag); + puq_wag = u3j_gate_slam(&raq_u, u3nc(par_u->res, puq_wag)); + par_u = u3a_pop(&pil_u); + } + + u3j_gate_lose(&raq_u); + } + + return u3nq(p_wag, u3_nul, puq_wag, quq_wag); + } + + u3_noun + u3we_stir_fun(u3_noun cor) + { + u3_noun van, rud, raq, fel, tub; + + if ( (c3n == u3r_mean(cor, u3x_sam, &tub, u3x_con, &van, 0)) || + (c3n == u3r_mean(van, u3x_sam_2, &rud, + u3x_sam_6, &raq, + u3x_sam_7, &fel, + 0)) ) + { + return u3m_bail(c3__fail); + } else { + return _cqe_stir_fun(rud, raq, fel, tub); + } + } + + #undef _p + #undef _q +
\ No newline at end of file diff --git a/vere/pkg/noun/jets/e/rd.c b/vere/pkg/noun/jets/e/rd.c new file mode 100644 index 0000000..a693e3f --- /dev/null +++ b/vere/pkg/noun/jets/e/rd.c @@ -0,0 +1,390 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "softfloat.h" + +#define DOUBNAN 0x7ff8000000000000 + + union doub { + float64_t d; + c3_d c; + }; + + static inline c3_t + _nan_test(float64_t a) + { + return !f64_eq(a, a); + } + + static inline float64_t + _nan_unify(float64_t a) + { + if ( _nan_test(a) ) + { + *(c3_d*)(&a) = DOUBNAN; + } + return a; + } + + static inline void + _set_rounding(c3_w a) + { + switch ( a ) + { + default: + u3m_bail(c3__fail); + break; + case c3__n: + softfloat_roundingMode = softfloat_round_near_even; + break; + case c3__z: + softfloat_roundingMode = softfloat_round_minMag; + break; + case c3__u: + softfloat_roundingMode = softfloat_round_max; + break; + case c3__d: + softfloat_roundingMode = softfloat_round_min; + break; + } + } + +/* add +*/ + u3_noun + u3qer_add(u3_atom a, + u3_atom b, + u3_atom r) + { + union doub c, d, e; + _set_rounding(r); + c.c = u3r_chub(0, a); + d.c = u3r_chub(0, b); + e.d = _nan_unify(f64_add(c.d, d.d)); + + return u3i_chubs(1, &e.c); + } + + u3_noun + u3wer_add(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); + } + else { + return u3qer_add(a, b, u3x_at(30, cor)); + } + } + +/* sub +*/ + u3_noun + u3qer_sub(u3_atom a, + u3_atom b, + u3_atom r) + { + union doub c, d, e; + _set_rounding(r); + c.c = u3r_chub(0, a); + d.c = u3r_chub(0, b); + e.d = _nan_unify(f64_sub(c.d, d.d)); + + return u3i_chubs(1, &e.c); + } + + u3_noun + u3wer_sub(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); + } + else { + return u3qer_sub(a, b, u3x_at(30, cor)); + } + } + +/* mul +*/ + u3_noun + u3qer_mul(u3_atom a, + u3_atom b, + u3_atom r) + { + union doub c, d, e; + _set_rounding(r); + c.c = u3r_chub(0, a); + d.c = u3r_chub(0, b); + e.d = _nan_unify(f64_mul(c.d, d.d)); + + return u3i_chubs(1, &e.c); + } + + u3_noun + u3wer_mul(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); + } + else { + return u3qer_mul(a, b, u3x_at(30, cor)); + } + } + +/* div +*/ + u3_noun + u3qer_div(u3_atom a, + u3_atom b, + u3_atom r) + { + union doub c, d, e; + _set_rounding(r); + c.c = u3r_chub(0, a); + d.c = u3r_chub(0, b); + e.d = _nan_unify(f64_div(c.d, d.d)); + + return u3i_chubs(1, &e.c); + } + + u3_noun + u3wer_div(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); + } + else { + return u3qer_div(a, b, u3x_at(30, cor)); + } + } + +/* sqt +*/ + u3_noun + u3qer_sqt(u3_atom a, + u3_atom r) + { + union doub c, d; + _set_rounding(r); + c.c = u3r_chub(0, a); + d.d = _nan_unify(f64_sqrt(c.d)); + + return u3i_chubs(1, &d.c); + } + + u3_noun + u3wer_sqt(u3_noun cor) + { + u3_noun a; + + if ( c3n == (a = u3r_at(u3x_sam, cor)) || + c3n == u3ud(a) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qer_sqt(a, u3x_at(30, cor)); + } + } + +/* fma +*/ + u3_noun + u3qer_fma(u3_atom a, + u3_atom b, + u3_atom c, + u3_atom r) + { + union doub d, e, f, g; + _set_rounding(r); + d.c = u3r_chub(0, a); + e.c = u3r_chub(0, b); + f.c = u3r_chub(0, c); + g.d = _nan_unify(f64_mulAdd(d.d, e.d, f.d)); + + return u3i_chubs(1, &g.c); + } + + u3_noun + u3wer_fma(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_6, &b, u3x_sam_7, &c, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) || + c3n == u3ud(c) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qer_fma(a, b, c, u3x_at(30, cor)); + } + } + +/* lth +*/ + u3_noun + u3qer_lth(u3_atom a, + u3_atom b) + { + union doub c, d; + c.c = u3r_chub(0, a); + d.c = u3r_chub(0, b); + + return __(f64_lt(c.d, d.d)); + } + + u3_noun + u3wer_lth(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); + } + else { + return u3qer_lth(a, b); + } + } + +/* lte +*/ + u3_noun + u3qer_lte(u3_atom a, + u3_atom b) + { + union doub c, d; + c.c = u3r_chub(0, a); + d.c = u3r_chub(0, b); + + return __(f64_le(c.d, d.d)); + } + + u3_noun + u3wer_lte(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); + } + else { + return u3qer_lte(a, b); + } + } + +/* equ +*/ + u3_noun + u3qer_equ(u3_atom a, + u3_atom b) + { + union doub c, d; + c.c = u3r_chub(0, a); + d.c = u3r_chub(0, b); + + return __(f64_eq(c.d, d.d)); + } + + u3_noun + u3wer_equ(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); + } + else { + return u3qer_equ(a, b); + } + } + +/* gte +*/ + u3_noun + u3qer_gte(u3_atom a, + u3_atom b) + { + union doub c, d; + c.c = u3r_chub(0, a); + d.c = u3r_chub(0, b); + + return __(f64_le(d.d, c.d)); + } + + u3_noun + u3wer_gte(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); + } + else { + return u3qer_gte(a, b); + } + } + +/* gth +*/ + u3_noun + u3qer_gth(u3_atom a, + u3_atom b) + { + union doub c, d; + c.c = u3r_chub(0, a); + d.c = u3r_chub(0, b); + + return __(f64_lt(d.d, c.d)); + } + + u3_noun + u3wer_gth(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); + } + else { + return u3qer_gth(a, b); + } + } diff --git a/vere/pkg/noun/jets/e/rh.c b/vere/pkg/noun/jets/e/rh.c new file mode 100644 index 0000000..3bbb8d4 --- /dev/null +++ b/vere/pkg/noun/jets/e/rh.c @@ -0,0 +1,390 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "softfloat.h" + +#define HALFNAN 0x7e00 + + union half { + float16_t h; + c3_s c; + }; + + static inline c3_t + _nan_test(float16_t a) + { + return !f16_eq(a, a); + } + + static inline float16_t + _nan_unify(float16_t a) + { + if ( _nan_test(a) ) + { + *(c3_s*)(&a) = HALFNAN; + } + return a; + } + + static inline void + _set_rounding(c3_w a) + { + switch ( a ) + { + default: + u3m_bail(c3__fail); + break; + case c3__n: + softfloat_roundingMode = softfloat_round_near_even; + break; + case c3__z: + softfloat_roundingMode = softfloat_round_minMag; + break; + case c3__u: + softfloat_roundingMode = softfloat_round_max; + break; + case c3__d: + softfloat_roundingMode = softfloat_round_min; + break; + } + } + +/* add +*/ + u3_noun + u3qes_add(u3_atom a, + u3_atom b, + u3_atom r) + { + union half c, d, e; + _set_rounding(r); + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + e.h = _nan_unify(f16_add(c.h, d.h)); + + return e.c; + } + + u3_noun + u3wes_add(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); + } + else { + return u3qes_add(a, b, u3x_at(30, cor)); + } + } + +/* sub +*/ + u3_noun + u3qes_sub(u3_atom a, + u3_atom b, + u3_atom r) + { + union half c, d, e; + _set_rounding(r); + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + e.h = _nan_unify(f16_sub(c.h, d.h)); + + return e.c; + } + + u3_noun + u3wes_sub(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); + } + else { + return u3qes_sub(a, b, u3x_at(30, cor)); + } + } + +/* mul +*/ + u3_noun + u3qes_mul(u3_atom a, + u3_atom b, + u3_atom r) + { + union half c, d, e; + _set_rounding(r); + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + e.h = _nan_unify(f16_mul(c.h, d.h)); + + return e.c; + } + + u3_noun + u3wes_mul(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); + } + else { + return u3qes_mul(a, b, u3x_at(30, cor)); + } + } + +/* div +*/ + u3_noun + u3qes_div(u3_atom a, + u3_atom b, + u3_atom r) + { + union half c, d, e; + _set_rounding(r); + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + e.h = _nan_unify(f16_div(c.h, d.h)); + + return e.c; + } + + u3_noun + u3wes_div(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); + } + else { + return u3qes_div(a, b, u3x_at(30, cor)); + } + } + +/* sqt +*/ + u3_noun + u3qes_sqt(u3_atom a, + u3_atom r) + { + union half c, d; + _set_rounding(r); + c.c = u3r_word(0, a); + d.h = _nan_unify(f16_sqrt(c.h)); + + return d.c; + } + + u3_noun + u3wes_sqt(u3_noun cor) + { + u3_noun a; + + if ( c3n == (a = u3r_at(u3x_sam, cor)) || + c3n == u3ud(a) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qes_sqt(a, u3x_at(30, cor)); + } + } + +/* fma +*/ + u3_noun + u3qes_fma(u3_atom a, + u3_atom b, + u3_atom c, + u3_atom r) + { + union half d, e, f, g; + _set_rounding(r); + d.c = u3r_word(0, a); + e.c = u3r_word(0, b); + f.c = u3r_word(0, c); + g.h = _nan_unify(f16_mulAdd(d.h, e.h, f.h)); + + return g.c; + } + + u3_noun + u3wes_fma(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_6, &b, u3x_sam_7, &c, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) || + c3n == u3ud(c) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qes_fma(a, b, c, u3x_at(30, cor)); + } + } + +/* lth +*/ + u3_noun + u3qes_lth(u3_atom a, + u3_atom b) + { + union half c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f16_lt(c.h, d.h)); + } + + u3_noun + u3wes_lth(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); + } + else { + return u3qes_lth(a, b); + } + } + +/* lte +*/ + u3_noun + u3qes_lte(u3_atom a, + u3_atom b) + { + union half c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f16_le(c.h, d.h)); + } + + u3_noun + u3wes_lte(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); + } + else { + return u3qes_lte(a, b); + } + } + +/* equ +*/ + u3_noun + u3qes_equ(u3_atom a, + u3_atom b) + { + union half c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f16_eq(c.h, d.h)); + } + + u3_noun + u3wes_equ(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); + } + else { + return u3qes_equ(a, b); + } + } + +/* gte +*/ + u3_noun + u3qes_gte(u3_atom a, + u3_atom b) + { + union half c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f16_le(d.h, c.h)); + } + + u3_noun + u3wes_gte(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); + } + else { + return u3qes_gte(a, b); + } + } + +/* gth +*/ + u3_noun + u3qes_gth(u3_atom a, + u3_atom b) + { + union half c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f16_lt(d.h, c.h)); + } + + u3_noun + u3wes_gth(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); + } + else { + return u3qes_gth(a, b); + } + } diff --git a/vere/pkg/noun/jets/e/ripe.c b/vere/pkg/noun/jets/e/ripe.c new file mode 100644 index 0000000..5d08a9d --- /dev/null +++ b/vere/pkg/noun/jets/e/ripe.c @@ -0,0 +1,45 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_atom + _cqe_ripe(u3_atom wid, u3_atom dat) + { + c3_w len_w; + if ( !u3r_word_fit(&len_w, wid) ) { + return u3m_bail(c3__fail); + } + else { + u3_atom ret; + c3_y out_y[20]; + c3_y *dat_y = u3r_bytes_alloc(0, len_w, dat); + + ret = ( 0 == urcrypt_ripemd160(dat_y, len_w, out_y) ) + ? u3i_bytes(20, out_y) + : u3_none; + + u3a_free(dat_y); + return ret; + } + } + + u3_noun + u3we_ripe(u3_noun cor) + { + u3_noun wid, dat; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &wid, + u3x_sam_3, &dat, 0) || + u3ud(wid) || u3ud(dat)) + ) + { + return u3m_bail(c3__exit); + } + else { + return u3l_punt("ripe", _cqe_ripe(wid, dat)); + } + } diff --git a/vere/pkg/noun/jets/e/rq.c b/vere/pkg/noun/jets/e/rq.c new file mode 100644 index 0000000..e26a4de --- /dev/null +++ b/vere/pkg/noun/jets/e/rq.c @@ -0,0 +1,446 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "softfloat.h" + +#define QUADNAN 0x7fff800000000000 + + union quad { + float128_t* q; + c3_w* c; + }; + + static inline c3_t + _nan_test(float128_t* a) + { + return !f128M_eq(a, a); + } + + static inline void + _nan_unify(float128_t* a) + { + if ( _nan_test(a) ) + { + *( (c3_d*)a) = 0; + *(((c3_d*)a)+1) = QUADNAN; + } + } + + static inline void + _set_rounding(c3_w a) + { + switch ( a ) + { + default: + u3m_bail(c3__fail); + break; + case c3__n: + softfloat_roundingMode = softfloat_round_near_even; + break; + case c3__z: + softfloat_roundingMode = softfloat_round_minMag; + break; + case c3__u: + softfloat_roundingMode = softfloat_round_max; + break; + case c3__d: + softfloat_roundingMode = softfloat_round_min; + break; + } + } + +/* add +*/ + u3_noun + u3qeq_add(u3_atom a, + u3_atom b, + u3_atom r) + { + union quad c, d, e; + _set_rounding(r); + c.c = alloca(16); + d.c = alloca(16); + e.c = alloca(16); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + f128M_add(c.q, d.q, e.q); + _nan_unify(e.q); + + u3_atom f = u3i_words(4, e.c); + return f; + } + + u3_noun + u3weq_add(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); + } + else { + return u3qeq_add(a, b, u3x_at(30, cor)); + } + } + +/* sub +*/ + u3_noun + u3qeq_sub(u3_atom a, + u3_atom b, + u3_atom r) + { + union quad c, d, e; + _set_rounding(r); + c.c = alloca(16); + d.c = alloca(16); + e.c = alloca(16); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + f128M_sub(c.q, d.q, e.q); + _nan_unify(e.q); + + u3_atom f = u3i_words(4, e.c); + return f; + } + + u3_noun + u3weq_sub(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); + } + else { + return u3qeq_sub(a, b, u3x_at(30, cor)); + } + } + +/* mul +*/ + u3_noun + u3qeq_mul(u3_atom a, + u3_atom b, + u3_atom r) + { + union quad c, d, e; + _set_rounding(r); + c.c = alloca(16); + d.c = alloca(16); + e.c = alloca(16); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + f128M_mul(c.q, d.q, e.q); + _nan_unify(e.q); + + u3_atom f = u3i_words(4, e.c); + return f; + } + + u3_noun + u3weq_mul(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); + } + else { + return u3qeq_mul(a, b, u3x_at(30, cor)); + } + } + +/* div +*/ + u3_noun + u3qeq_div(u3_atom a, + u3_atom b, + u3_atom r) + { + union quad c, d, e; + _set_rounding(r); + c.c = alloca(16); + d.c = alloca(16); + e.c = alloca(16); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + f128M_div(c.q, d.q, e.q); + _nan_unify(e.q); + + u3_atom f = u3i_words(4, e.c); + return f; + } + + u3_noun + u3weq_div(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); + } + else { + return u3qeq_div(a, b, u3x_at(30, cor)); + } + } + +/* sqt +*/ + u3_noun + u3qeq_sqt(u3_atom a, + u3_atom r) + { + union quad c, d; + _set_rounding(r); + c.c = alloca(16); + d.c = alloca(16); + + u3r_words(0, 4, c.c, a); + f128M_sqrt(c.q, d.q); + _nan_unify(d.q); + + u3_atom e = u3i_words(4, d.c); + return e; + } + + u3_noun + u3weq_sqt(u3_noun cor) + { + u3_noun a; + + if ( c3n == (a = u3r_at(u3x_sam, cor)) || + c3n == u3ud(a) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qeq_sqt(a, u3x_at(30, cor)); + } + } + +/* fma +*/ + u3_noun + u3qeq_fma(u3_atom a, + u3_atom b, + u3_atom c, + u3_atom r) + { + union quad d, e, f, g; + _set_rounding(r); + d.c = alloca(16); + e.c = alloca(16); + f.c = alloca(16); + g.c = alloca(16); + + u3r_words(0, 4, d.c, a); + u3r_words(0, 4, e.c, b); + u3r_words(0, 4, f.c, c); + f128M_mulAdd(d.q, e.q, f.q, g.q); + _nan_unify(g.q); + + u3_atom h = u3i_words(4, g.c); + return h; + } + + u3_noun + u3weq_fma(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_6, &b, u3x_sam_7, &c, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) || + c3n == u3ud(c) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qeq_fma(a, b, c, u3x_at(30, cor)); + } + } + +/* lth +*/ + u3_noun + u3qeq_lth(u3_atom a, + u3_atom b) + { + union quad c, d; + c.c = alloca(16); + d.c = alloca(16); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_lt(c.q, d.q)); + + return e; + } + + u3_noun + u3weq_lth(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); + } + else { + return u3qeq_lth(a, b); + } + } + +/* lte +*/ + u3_noun + u3qeq_lte(u3_atom a, + u3_atom b) + { + union quad c, d; + c.c = alloca(16); + d.c = alloca(16); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_le(c.q, d.q)); + + return e; + } + + u3_noun + u3weq_lte(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); + } + else { + return u3qeq_lte(a, b); + } + } + +/* equ +*/ + u3_noun + u3qeq_equ(u3_atom a, + u3_atom b) + { + union quad c, d; + c.c = alloca(16); + d.c = alloca(16); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_eq(c.q, d.q)); + + return e; + } + + u3_noun + u3weq_equ(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); + } + else { + return u3qeq_equ(a, b); + } + } + +/* gte +*/ + u3_noun + u3qeq_gte(u3_atom a, + u3_atom b) + { + union quad c, d; + c.c = alloca(16); + d.c = alloca(16); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_le(d.q, c.q)); + + return e; + } + + u3_noun + u3weq_gte(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); + } + else { + return u3qeq_gte(a, b); + } + } + +/* gth +*/ + u3_noun + u3qeq_gth(u3_atom a, + u3_atom b) + { + union quad c, d; + c.c = alloca(16); + d.c = alloca(16); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_lt(d.q, c.q)); + + return e; + } + + u3_noun + u3weq_gth(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); + } + else { + return u3qeq_gth(a, b); + } + } diff --git a/vere/pkg/noun/jets/e/rs.c b/vere/pkg/noun/jets/e/rs.c new file mode 100644 index 0000000..360d1c9 --- /dev/null +++ b/vere/pkg/noun/jets/e/rs.c @@ -0,0 +1,390 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "softfloat.h" + +#define SINGNAN 0x7fc00000 + + union sing { + float32_t s; + c3_w c; + }; + + static inline c3_t + _nan_test(float32_t a) + { + return !f32_eq(a, a); + } + + static inline float32_t + _nan_unify(float32_t a) + { + if ( _nan_test(a) ) + { + *(c3_w*)(&a) = SINGNAN; + } + return a; + } + + static inline void + _set_rounding(c3_w a) + { + switch ( a ) + { + default: + u3m_bail(c3__fail); + break; + case c3__n: + softfloat_roundingMode = softfloat_round_near_even; + break; + case c3__z: + softfloat_roundingMode = softfloat_round_minMag; + break; + case c3__u: + softfloat_roundingMode = softfloat_round_max; + break; + case c3__d: + softfloat_roundingMode = softfloat_round_min; + break; + } + } + +/* add +*/ + u3_noun + u3qet_add(u3_atom a, + u3_atom b, + u3_atom r) + { + union sing c, d, e; + _set_rounding(r); + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + e.s = _nan_unify(f32_add(c.s, d.s)); + + return u3i_words(1, &e.c); + } + + u3_noun + u3wet_add(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); + } + else { + return u3qet_add(a, b, u3x_at(30, cor)); + } + } + +/* sub +*/ + u3_noun + u3qet_sub(u3_atom a, + u3_atom b, + u3_atom r) + { + union sing c, d, e; + _set_rounding(r); + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + e.s = _nan_unify(f32_sub(c.s, d.s)); + + return u3i_words(1, &e.c); + } + + u3_noun + u3wet_sub(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); + } + else { + return u3qet_sub(a, b, u3x_at(30, cor)); + } + } + +/* mul +*/ + u3_noun + u3qet_mul(u3_atom a, + u3_atom b, + u3_atom r) + { + union sing c, d, e; + _set_rounding(r); + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + e.s = _nan_unify(f32_mul(c.s, d.s)); + + return u3i_words(1, &e.c); + } + + u3_noun + u3wet_mul(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); + } + else { + return u3qet_mul(a, b, u3x_at(30, cor)); + } + } + +/* div +*/ + u3_noun + u3qet_div(u3_atom a, + u3_atom b, + u3_atom r) + { + union sing c, d, e; + _set_rounding(r); + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + e.s = _nan_unify(f32_div(c.s, d.s)); + + return u3i_words(1, &e.c); + } + + u3_noun + u3wet_div(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); + } + else { + return u3qet_div(a, b, u3x_at(30, cor)); + } + } + +/* sqt +*/ + u3_noun + u3qet_sqt(u3_atom a, + u3_atom r) + { + union sing c, d; + _set_rounding(r); + c.c = u3r_word(0, a); + d.s = _nan_unify(f32_sqrt(c.s)); + + return u3i_words(1, &d.c); + } + + u3_noun + u3wet_sqt(u3_noun cor) + { + u3_noun a; + + if ( c3n == (a = u3r_at(u3x_sam, cor)) || + c3n == u3ud(a) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qet_sqt(a, u3x_at(30, cor)); + } + } + +/* fma +*/ + u3_noun + u3qet_fma(u3_atom a, + u3_atom b, + u3_atom c, + u3_atom r) + { + union sing d, e, f, g; + _set_rounding(r); + d.c = u3r_word(0, a); + e.c = u3r_word(0, b); + f.c = u3r_word(0, c); + g.s = _nan_unify(f32_mulAdd(d.s, e.s, f.s)); + + return u3i_words(1, &g.c); + } + + u3_noun + u3wet_fma(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_6, &b, u3x_sam_7, &c, 0) || + c3n == u3ud(a) || + c3n == u3ud(b) || + c3n == u3ud(c) ) + { + return u3m_bail(c3__exit); + } + else { + return u3qet_fma(a, b, c, u3x_at(30, cor)); + } + } + +/* lth +*/ + u3_noun + u3qet_lth(u3_atom a, + u3_atom b) + { + union sing c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f32_lt(c.s, d.s)); + } + + u3_noun + u3wet_lth(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); + } + else { + return u3qet_lth(a, b); + } + } + +/* lte +*/ + u3_noun + u3qet_lte(u3_atom a, + u3_atom b) + { + union sing c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f32_le(c.s, d.s)); + } + + u3_noun + u3wet_lte(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); + } + else { + return u3qet_lte(a, b); + } + } + +/* equ +*/ + u3_noun + u3qet_equ(u3_atom a, + u3_atom b) + { + union sing c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f32_eq(c.s, d.s)); + } + + u3_noun + u3wet_equ(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); + } + else { + return u3qet_equ(a, b); + } + } + +/* gte +*/ + u3_noun + u3qet_gte(u3_atom a, + u3_atom b) + { + union sing c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f32_le(d.s, c.s)); + } + + u3_noun + u3wet_gte(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); + } + else { + return u3qet_gte(a, b); + } + } + +/* gth +*/ + u3_noun + u3qet_gth(u3_atom a, + u3_atom b) + { + union sing c, d; + c.c = u3r_word(0, a); + d.c = u3r_word(0, b); + + return __(f32_lt(d.s, c.s)); + } + + u3_noun + u3wet_gth(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); + } + else { + return u3qet_gth(a, b); + } + } diff --git a/vere/pkg/noun/jets/e/rub.c b/vere/pkg/noun/jets/e/rub.c new file mode 100644 index 0000000..81739be --- /dev/null +++ b/vere/pkg/noun/jets/e/rub.c @@ -0,0 +1,85 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qe_rub(u3_atom a, + u3_atom b) + { + u3_atom c, d, e; + u3_atom w, x, y, z; + u3_atom p, q; + + u3_atom m; + { + c3_w bit_w = u3r_met(0, b); + u3_noun bit = u3i_words(1, &bit_w); + m = u3qa_add(a, bit); + u3z(bit); + } + + // Compute c and d. + { + x = u3k(a); + + while ( 0 == u3qc_cut(0, x, 1, b) ) { + u3_atom y = u3qa_inc(x); + + // Sanity check: crash if decoding more bits than available + if ( c3y == u3qa_gth(x, m)) { + // u3l_log("[%%rub-hard %d %d %d]", a, x, m); + return u3m_bail(c3__exit); + } + + u3z(x); + x = y; + } + if ( c3y == u3r_sing(x, a) ) { + u3z(x); + return u3nc(1, 0); + } + c = u3qa_sub(x, a); + d = u3qa_inc(x); + + u3z(x); + } + + // Compute e, p, q. + { + x = u3qa_dec(c); + y = u3qc_bex(x); + z = u3qc_cut(0, d, x, b); + + e = u3qa_add(y, z); + u3z(y); u3z(z); + + w = u3qa_add(c, c); + y = u3qa_add(w, e); + z = u3qa_add(d, x); + + p = u3qa_add(w, e); + q = u3qc_cut(0, z, e, b); + + u3z(w); u3z(x); u3z(y); u3z(z); + + return u3nc(p, q); + } + } + u3_noun + u3we_rub(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__fail); + } else { + return u3qe_rub(a, b); + } + } diff --git a/vere/pkg/noun/jets/e/scot.c b/vere/pkg/noun/jets/e/scot.c new file mode 100644 index 0000000..f39c46b --- /dev/null +++ b/vere/pkg/noun/jets/e/scot.c @@ -0,0 +1,30 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +#include <ctype.h> + +u3_atom +u3qe_scot(u3_atom a, u3_atom b) +{ + switch (a) { + case c3__tas: return u3k(b); + case c3__ud: return u3s_etch_ud(b); + case c3__ux: return u3s_etch_ux(b); + case c3__uv: return u3s_etch_uv(b); + case c3__uw: return u3s_etch_uw(b); + default: return u3_none; + } +} + +u3_noun +u3we_scot(u3_noun cor) +{ + u3_atom a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qe_scot(u3x_atom(a), u3x_atom(b)); +} diff --git a/vere/pkg/noun/jets/e/scow.c b/vere/pkg/noun/jets/e/scow.c new file mode 100644 index 0000000..986dc41 --- /dev/null +++ b/vere/pkg/noun/jets/e/scow.c @@ -0,0 +1,251 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +#include <ctype.h> + +static +c3_y to_digit(c3_y tig) +{ + if (tig >= 10) { + return 87 + tig; + } else { + return '0' + tig; + } +} + +// gives the characters for a four 'digit' small hex atom. +static +void +_x_co_four(c3_w src, c3_y* a, c3_y* b, c3_y* c, c3_y* d) +{ + *d = to_digit(src & 0xF); + src >>= 4; + *c = to_digit(src & 0xF); + src >>= 4; + *b = to_digit(src & 0xF); + src >>= 4; + *a = to_digit(src & 0xF); +} + +// The parser always prints two digits on 0 in y-co. +static +void +_y_co_two(c3_w src, c3_y* a, c3_y* b) +{ + *b = to_digit(src % 10); + *a = to_digit(src / 10); +} + +// +static +u3_noun +_add_year(c3_w year, u3_noun out) +{ + while (year > 0) { + out = u3nc(to_digit(year % 10), out); + year = year / 10; + } + + return out; +} + +static +u3_noun +_print_da(u3_noun cor, u3_atom raw_da) +{ + u3_noun hok = u3j_cook("u3we_scow_print_da", u3k(cor), "yore"); + u3_noun yod = u3n_slam_on(hok, u3k(raw_da)); + + u3_noun out = 0; + + u3_atom age, year, month, day, hour, min, sec, f; + if (c3n == u3r_mean(yod, 4, &age, + 5, &year, + 6, &month, + 14, &day, + 30, &hour, + 62, &min, + 126, &sec, + 127, &f, + 0)) { + return u3m_bail(c3__exit); + } + + if (f != 0) { + u3_noun f_list = u3qb_flop(f); + + for (u3_noun cur = f_list; + _(u3a_is_cell(cur)); + cur = u3t(cur)) { + if (_(u3a_is_cat(u3h(cur)))) { + c3_y a, b, c, d; + _x_co_four(u3h(cur), &a, &b, &c, &d); + out = u3nq('.', a, b, u3nt(c, d, out)); + } else { + // No way to deal with big atoms. fall back. + u3z(yod); + u3z(out); + u3z(f_list); + return u3_none; + } + } + + u3z(f_list); + out = u3nc('.', out); + } + + // if there isn't a hex list and the h/m/s are all 0, skip printing hours. + if (f != 0 || hour != 0 || min != 0 || sec != 0) { + if (!_(u3a_is_cat(hour)) || + !_(u3a_is_cat(min)) || + !_(u3a_is_cat(sec))) { + // Input is weird, fallback to nock. + u3z(yod); + u3z(out); + return u3_none; + } + + c3_y sa, sb, ma, mb, ha, hb; + _y_co_two(sec, &sa, &sb); + out = u3nq('.', sa, sb, out); + + _y_co_two(min, &ma, &mb); + out = u3nq('.', ma, mb, out); + + _y_co_two(hour, &ha, &hb); + out = u3nq('.', ha, hb, out); + + out = u3nc('.', out); + } + + // We always print the Y.M.D. Unlike others, these numbers are unconstrained + // by length, but in practice, the month number and day number can only be up + // to two digits because of +yore. We still need to remove 0 prefixes, + // though. + if (!_(u3a_is_cat(day)) || day > 99 || + !_(u3a_is_cat(month)) || month > 99 || + !_(u3a_is_cat(year))) { + // Input is weird, fallback to nock. + u3z(yod); + u3z(out); + return u3_none; + } + + c3_y da, db; + _y_co_two(day, &da, &db); + out = u3nc(db, out); + if (da != '0') { + out = u3nc(da, out); + } + out = u3nc('.', out); + + c3_y ma, mb; + _y_co_two(month, &ma, &mb); + out = u3nc(mb, out); + if (ma != '0') { + out = u3nc(ma, out); + } + out = u3nc('.', out); + + // suffix the year with a '-' for BC dates + if (age == c3n) { + out = u3nc('-', out); + } + + // The year part is the only place where we have to explicitly loop over the + // input because it can be arbitrarily large or small. + out = _add_year(year, out); + + out = u3nc('~', out); + + u3z(yod); + return out; +} + +static +u3_noun +_print_p(u3_atom cor, u3_atom p) +{ + // Scramble the raw number to the concealed version. + u3_noun ob = u3j_cook("u3we_scow_ob_p", u3k(cor), "ob"); + u3_noun hok = u3j_cook("u3we_scow_fein_p", ob, "fein"); + u3_atom sxz = u3n_slam_on(hok, u3k(p)); + + // Simple galaxy case + if (c3y == u3qa_lth(sxz, 256)) { + c3_y a, b, c; + u3_po_to_suffix(sxz, &a, &b, &c); + u3z(sxz); + return u3nq('~', a, b, u3nc(c, 0)); + } + + u3_atom dyy = u3qc_met(4, sxz); + if (!_(u3a_is_cat(dyy))) { + u3z(sxz); + u3z(dyy); + return u3_none; + } + + u3_noun list = 0; + for (c3_w imp = 0; imp != dyy; ++imp) { + c3_w log = u3qc_end(4, 1, sxz); + c3_w prefix = u3qc_rsh(3, 1, log); + c3_w suffix = u3qc_end(3, 1, log); + + c3_y a, b, c, d, e, f; + u3_po_to_prefix(prefix, &a, &b, &c); + u3_po_to_suffix(suffix, &d, &e, &f); + + if (imp % 4 == 0) { + if (imp != 0) { + list = u3nt('-', '-', list); + } + } else { + list = u3nc('-', list); + } + + list = u3nq(a, b, c, u3nq(d, e, f, list)); + + sxz = u3qc_rsh(4, 1, sxz); + } + + u3z(sxz); + return u3nc('~', list); +} + +u3_atom +u3qe_scow(u3_atom a, u3_atom b) +{ + switch (a) { + // XX disabled due to memory corruption + // rewrite for +scot jet and test there + // + // case c3__da: return _print_da(cor, atom); + // case 'p': return _print_p(cor, atom); + + default: { + u3_weak dat = u3qe_scot(a, b); + u3_weak pro = u3_none; + + if ( u3_none != dat ) { + pro = u3qc_rip(3, 1, dat); + u3z(dat); + } + + return pro; + } + } +} + +u3_noun +u3we_scow(u3_noun cor) +{ + u3_atom a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qe_scow(u3x_atom(a), u3x_atom(b)); +} diff --git a/vere/pkg/noun/jets/e/scr.c b/vere/pkg/noun/jets/e/scr.c new file mode 100644 index 0000000..e9d0725 --- /dev/null +++ b/vere/pkg/noun/jets/e/scr.c @@ -0,0 +1,227 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_weak + _cqes_hs(u3_atom p, c3_w pwd_w, + u3_atom s, c3_w sal_w, + u3_atom n, + u3_atom r, + u3_atom z, + u3_atom d) + { + u3_noun chk; + c3_w out_w; + + if ( !u3r_word_fit(&out_w, d) ) { + return u3m_bail(c3__fail); + } + if ( 0 == r || 0 == z ) { + return u3m_bail(c3__exit); + } + chk = u3qc_bex(31); + if ( (c3n == u3qa_lth(pwd_w, chk)) || + (c3n == u3qa_lth(sal_w, chk)) ) { + return u3m_bail(c3__exit); + } + u3z(chk); + chk = u3kc_bex(u3ka_dec(u3qc_xeb(n))); + if ( c3n == u3r_sing(n, chk) ) { + return u3m_bail(c3__exit); + } + u3z(chk); + if ( c3n == u3ka_lte( + u3ka_mul(u3qa_mul(128, r), u3ka_dec(u3qa_add(n, z))), + u3qc_bex(30)) ) { + return u3m_bail(c3__exit); + } + + if ( (u3r_met(6, n) > 1) || + (u3r_met(5, r) > 1) || + (u3r_met(5, z) > 1) ) { + return u3_none; + } + else { + u3_noun pro; + c3_d n_d = u3r_chub(0, n); + c3_w r_w = u3r_word(0, r), + z_w = u3r_word(0, z); + c3_y *pwd_y = u3a_malloc(pwd_w), + *sal_y = u3a_malloc(sal_w), + *out_y = u3a_malloc(d); + u3r_bytes(0, pwd_w, pwd_y, p); + u3r_bytes(0, sal_w, sal_y, s); + pro = ( 0 == urcrypt_scrypt(pwd_y, pwd_w, + sal_y, sal_w, + n_d, r_w, z_w, + out_w, out_y) ) + ? u3i_bytes(out_w, out_y) + : u3_none; + u3a_free(pwd_y); + u3a_free(sal_y); + u3a_free(out_y); + return pro; + } + } + + static u3_weak + _cqes_hsl(u3_atom p, u3_atom pl, + u3_atom s, u3_atom sl, + u3_atom n, + u3_atom r, + u3_atom z, + u3_atom d) + { + c3_w pwd_w, sal_w; + if ( !(u3r_word_fit(&pwd_w, pl) && + u3r_word_fit(&sal_w, sl)) ) { + return u3m_bail(c3__fail); + } + else { + return _cqes_hs(p, pwd_w, s, sal_w, n, r, z, d); + } + } + + u3_noun + u3wes_hsl(u3_noun cor) + { + u3_noun p, pl, s, sl, n, r, z, d; + u3_noun q; + + u3x_quil(u3x_at(u3x_sam, cor), &p, &pl, &s, &sl, &q); + u3x_qual(q, &n, &r, &z, &d); + + if ( !(_(u3a_is_atom(p)) && _(u3a_is_atom(pl)) && + _(u3a_is_atom(s)) && _(u3a_is_atom(sl)) && + _(u3a_is_atom(n)) && _(u3a_is_atom(r)) && + _(u3a_is_atom(z)) && _(u3a_is_atom(d))) ) { + return u3m_bail(c3__exit); + } + else { + return u3l_punt("scr-hsl", _cqes_hsl(p, pl, s, sl, n, r, z, d)); + } + } + + static u3_weak + _cqes_hsh(u3_atom p, + u3_atom s, + u3_atom n, + u3_atom r, + u3_atom z, + u3_atom d) + { + return _cqes_hs(p, u3r_met(3, p), + s, u3r_met(3, s), + n, r, z, d); + } + + u3_noun + u3wes_hsh(u3_noun cor) + { + u3_noun p, s, n, r, z, d; + u3_noun q; + + u3x_quil(u3x_at(u3x_sam, cor), &p, &s, &n, &r, &q); + u3x_cell(q, &z, &d); + + if ( !(_(u3a_is_atom(p)) && _(u3a_is_atom(s)) && + _(u3a_is_atom(n)) && _(u3a_is_atom(r)) && + _(u3a_is_atom(z)) && _(u3a_is_atom(d))) ) { + return u3m_bail(c3__exit); + } + else { + return u3l_punt("scr-hsh", _cqes_hsh(p, s, n, r, z, d)); + } + } + + static u3_atom + _cqes_pb(u3_atom p, c3_w pwd_w, + u3_atom s, c3_w sal_w, + u3_atom c, + u3_atom d) + { + if ( (c > (1 << 28)) || + (d > (1 << 30)) ) { + // max key length 1gb + // max iterations 2^28 + return u3m_bail(c3__exit); + } + else { + u3_noun pro; + c3_y *pwd_y = u3a_malloc(pwd_w), + *sal_y = u3a_malloc(sal_w), + *out_y = u3a_malloc(d); + u3r_bytes(0, pwd_w, pwd_y, p); + u3r_bytes(0, sal_w, sal_y, s); + urcrypt_scrypt_pbkdf_sha256(pwd_y, pwd_w, sal_y, sal_w, c, d, out_y); + pro = u3i_bytes(d, out_y); + u3a_free(pwd_y); + u3a_free(sal_y); + u3a_free(out_y); + return pro; + } + } + + static u3_noun + _cqes_pbl(u3_atom p, u3_atom pl, + u3_atom s, u3_atom sl, + u3_atom c, + u3_atom d) + { + c3_w pwd_w, sal_w; + if ( !(u3r_word_fit(&pwd_w, pl) && + u3r_word_fit(&sal_w, sl)) ) { + return u3m_bail(c3__fail); + } + else { + return _cqes_pb(p, pwd_w, s, sal_w, c, d); + } + } + + u3_noun + u3wes_pbl(u3_noun cor) + { + u3_noun p, pl, s, sl, c, d; + u3_noun q; + + u3x_quil(u3x_at(u3x_sam, cor), &p, &pl, &s, &sl, &q); + u3x_cell(q, &c, &d); + + if ( !(_(u3a_is_atom(p)) && _(u3a_is_atom(s)) && + _(u3a_is_atom(pl)) && _(u3a_is_atom(sl)) && + _(u3a_is_atom(c)) && _(u3a_is_atom(d))) ) { + return u3m_bail(c3__exit); + } + else { + return _cqes_pbl(p, pl, s, sl, c, d); + } + } + + static u3_atom + _cqes_pbk(u3_atom p, u3_atom s, u3_atom c, u3_atom d) + { + return _cqes_pb(p, u3r_met(3, p), + s, u3r_met(3, s), + c, d); + } + + u3_noun + u3wes_pbk(u3_noun cor) + { + u3_noun p, s, c, d; + + u3x_qual(u3x_at(u3x_sam, cor), &p, &s, &c, &d); + + if ( !(_(u3a_is_atom(p)) && _(u3a_is_atom(s)) && + _(u3a_is_atom(c)) && _(u3a_is_atom(d))) ) { + return u3m_bail(c3__exit); + } + else { + return _cqes_pbk(p, s, c, d); + } + } diff --git a/vere/pkg/noun/jets/e/secp.c b/vere/pkg/noun/jets/e/secp.c new file mode 100644 index 0000000..fa0fbd2 --- /dev/null +++ b/vere/pkg/noun/jets/e/secp.c @@ -0,0 +1,298 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" +#include "ent/ent.h" + +static urcrypt_secp_context* sec_u; + +/* call at process start */ +void +u3je_secp_init() +{ + c3_y ent_y[32]; + ent_getentropy(ent_y, 32); + sec_u = malloc(urcrypt_secp_prealloc_size()); + + if ( 0 != urcrypt_secp_init(sec_u, ent_y) ) { + u3l_log("u3e_secp_init failed"); + abort(); + } +} + +/* call at process end */ +void +u3je_secp_stop() +{ + urcrypt_secp_destroy(sec_u); + free(sec_u); + sec_u = NULL; +} + +/* util funcs + */ +static c3_t +_cqes_in_order(u3_atom a) +{ + // this is the "n" parameter of the secp256k1 curve + static const c3_w now_w[8] = { + 0xd0364141, 0xbfd25e8c, 0xaf48a03b, 0xbaaedce6, + 0xfffffffe, 0xffffffff, 0xffffffff, 0xffffffff + }; + + if ( 0 == a ) { + return 0; + } + else if ( c3y == u3a_is_cat(a) ) { + return 1; + } + else { + u3a_atom* a_u = u3a_to_ptr(a); + c3_w len_w = a_u->len_w; + + if ( len_w < 8 ) { + return 1; + } + else if ( len_w > 8 ) { + return 0; + } + else { + c3_y i_y; + c3_w *buf_w = a_u->buf_w; + // loop from most to least significant words + for ( i_y = 8; i_y > 0; ) { + c3_w b_w = buf_w[i_y], + o_w = now_w[--i_y]; + if ( b_w < o_w ) { + return 1; + } + else if ( b_w > o_w ) { + return 0; + } + } + return 1; + } + } +} + +static void +_cqes_unpack_fe(u3_atom k, c3_y out_y[32]) +{ + if ( _cqes_in_order(k) ) { + u3r_bytes(0, 32, out_y, k); + } + else { + u3m_bail(c3__exit); + } +} + +/* sign hash with priv key + */ +static u3_noun +_cqes_sign(u3_atom has, + u3_atom prv) +{ + c3_y has_y[32]; + + if ( 0 != u3r_bytes_fit(32, has_y, has) ) { + return u3m_bail(c3__exit); + } + else { + c3_y prv_y[32], v_y, r_y[32], s_y[32]; + _cqes_unpack_fe(prv, prv_y); + + return( 0 == urcrypt_secp_sign(sec_u, has_y, prv_y, &v_y, r_y, s_y) ) + ? u3nt(v_y, u3i_bytes(32, r_y), u3i_bytes(32, s_y)) + : u3_none; + } +} + +u3_noun +u3we_sign(u3_noun cor) +{ + + u3_noun has, prv; + + if ( (c3n == u3r_mean(cor, + u3x_sam_2, &has, + u3x_sam_3, &prv, + 0)) || + (c3n == u3ud(has)) || + (c3n == u3ud(prv))) { + return u3m_bail(c3__exit); + } + else { + return u3l_punt("secp-sign", _cqes_sign(has, prv)); + } +} + +/* recover pubkey from signature (which is how we verify signatures) +*/ +static u3_noun +_cqes_reco(u3_atom has, + u3_atom siv, /* signature: v */ + u3_atom sir, /* signature: r */ + u3_atom sis) /* signature: s */ +{ + c3_y has_y[32]; + if ( !((siv < 4) && (0 == u3r_bytes_fit(32, has_y, has)) ) ) { + return u3m_bail(c3__exit); + } + else { + c3_y sir_y[32], sis_y[32], x_y[32], y_y[32]; + _cqes_unpack_fe(sir, sir_y); + _cqes_unpack_fe(sis, sis_y); + return + ( 0 == urcrypt_secp_reco(sec_u, has_y, siv, sir_y, sis_y, x_y, y_y) ) + ? u3nc(u3i_bytes(32, x_y), u3i_bytes(32, y_y)) + : u3_none; + } +} + +u3_noun +u3we_reco(u3_noun cor) +{ + u3_noun has, /* hash */ + siv, sir, sis; /* signature: v, r, s */ + + if ( (c3n == u3r_mean(cor, + u3x_sam_2, &has, + u3x_sam_6, &siv, + u3x_sam_14, &sir, + u3x_sam_15, &sis, + 0)) || + (c3n == u3ud(has)) || + (c3n == u3ud(siv)) || + (c3n == u3ud(sir)) || + (c3n == u3ud(sis)) ) { + return u3m_bail(c3__exit); + } + else { + return u3l_punt("secp-reco", _cqes_reco(has, siv, sir, sis)); + } +} + +static u3_atom +_cqes_make(u3_atom has, + u3_atom prv) +{ + c3_y has_y[32]; + + if ( 0 != u3r_bytes_fit(32, has_y, has) ) { + return u3m_bail(c3__exit); + } + else { + c3_y prv_y[32], out_y[32]; + _cqes_unpack_fe(prv, prv_y); + return ( 0 == urcrypt_secp_make(has_y, prv_y, out_y) ) + ? u3i_bytes(32, out_y) + : u3_none; + } +} + +u3_noun +u3we_make(u3_noun cor) +{ + u3_noun has, prv; + if ( (c3n == u3r_mean(cor, + u3x_sam_2, &has, + u3x_sam_3, &prv, + 0)) || + (c3n == u3ud(has)) || + (c3n == u3ud(prv)) ) { + return u3m_bail(c3__exit); + } + else { + return u3l_punt("secp-make", _cqes_make(has, prv)); + } +} + +/* create a schnorr signature +*/ +static u3_weak +_cqes_sosi(u3_atom sk, u3_atom m, u3_atom a) +{ + c3_y key_y[32]; + c3_y mes_y[32]; + c3_y aux_y[32]; + + if ( (0 != u3r_bytes_fit(32, key_y, sk)) || + (0 != u3r_bytes_fit(32, mes_y, m)) || + (0 != u3r_bytes_fit(32, aux_y, a)) ) + { + return u3m_bail(c3__exit); + } + else { + c3_y sig_y[64]; + + return + ( 0 == urcrypt_secp_schnorr_sign(sec_u, key_y, mes_y, aux_y, sig_y) ) + ? u3i_bytes(64, sig_y) + : u3_none; + } +} + +u3_noun +u3we_sosi(u3_noun cor) +{ + u3_noun key, mes, aux; + + if ( (c3n == u3r_mean(cor, + u3x_sam_2, &key, + u3x_sam_6, &mes, + u3x_sam_7, &aux, + 0)) || + (c3n == u3ud(key)) || + (c3n == u3ud(mes)) || + (c3n == u3ud(aux)) ) + { + return u3m_bail(c3__exit); + } + else { + return u3l_punt("secp-sosi", _cqes_sosi(key, mes, aux)); + } +} + +/* verify a schnorr signature +*/ +static u3_atom +_cqes_sove(u3_atom pk, u3_atom m, u3_atom sig) +{ + c3_y pub_y[32]; + c3_y mes_y[32]; + c3_y sig_y[64]; + + if ( (0 != u3r_bytes_fit(32, pub_y, pk)) || + (0 != u3r_bytes_fit(32, mes_y, m)) || + (0 != u3r_bytes_fit(64, sig_y, sig)) ) + { + return u3m_bail(c3__exit); + } + else { + return __(urcrypt_secp_schnorr_veri(sec_u, sig_y, mes_y, pub_y)); + } +} + +u3_noun +u3we_sove(u3_noun cor) +{ + u3_noun pub, mes, sig; + + if ( (c3n == u3r_mean(cor, + u3x_sam_2, &pub, + u3x_sam_6, &mes, + u3x_sam_7, &sig, + 0)) || + (c3n == u3ud(pub)) || + (c3n == u3ud(mes)) || + (c3n == u3ud(sig)) ) + { + return u3m_bail(c3__exit); + } + else { + return _cqes_sove(pub, mes, sig); + } +} diff --git a/vere/pkg/noun/jets/e/sha1.c b/vere/pkg/noun/jets/e/sha1.c new file mode 100644 index 0000000..729faf6 --- /dev/null +++ b/vere/pkg/noun/jets/e/sha1.c @@ -0,0 +1,40 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + static u3_noun + _cqe_sha1(u3_atom wid, u3_atom dat) + { + c3_w len_w; + if ( !u3r_word_fit(&len_w, wid) ) { + return u3m_bail(c3__fail); + } + else { + c3_y out_y[20]; + c3_y *dat_y = u3r_bytes_alloc(0, len_w, dat); + + urcrypt_sha1(dat_y, len_w, out_y); + u3a_free(dat_y); + return u3i_bytes(20, out_y); + } + } + + u3_noun + u3we_sha1(u3_noun cor) + { + u3_noun wid, dat; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &wid, u3x_sam_3, &dat, 0)) || + (c3n == u3ud(wid)) || + (c3n == u3ud(dat)) ) + { + return u3m_bail(c3__exit); + } + else { + return _cqe_sha1(wid, dat); + } + } diff --git a/vere/pkg/noun/jets/e/shax.c b/vere/pkg/noun/jets/e/shax.c new file mode 100644 index 0000000..856d0fa --- /dev/null +++ b/vere/pkg/noun/jets/e/shax.c @@ -0,0 +1,194 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" +#include "urcrypt.h" + + + static u3_atom + _cqe_shay(u3_atom wid, + u3_atom dat) + { + c3_w len_w; + if ( !u3r_word_fit(&len_w, wid) ) { + return u3m_bail(c3__fail); + } + else { + c3_y out_y[32]; + c3_y* dat_y = u3r_bytes_alloc(0, len_w, dat); + urcrypt_shay(dat_y, len_w, out_y); + u3a_free(dat_y); + return u3i_bytes(32, out_y); + } + } + + static u3_atom + _cqe_shax(u3_atom a) + { + c3_w len_w; + c3_y out_y[32]; + c3_y* dat_y = u3r_bytes_all(&len_w, a); + urcrypt_shay(dat_y, len_w, out_y); + u3a_free(dat_y); + return u3i_bytes(32, out_y); + } + + static u3_atom + _cqe_shal(u3_atom wid, + u3_atom dat) + { + c3_w len_w; + if ( !u3r_word_fit(&len_w, wid) ) { + return u3m_bail(c3__fail); + } + else { + c3_y out_y[64]; + c3_y* dat_y = u3r_bytes_alloc(0, len_w, dat); + urcrypt_shal(dat_y, len_w, out_y); + u3a_free(dat_y); + return u3i_bytes(64, out_y); + } + } + + static u3_atom + _cqe_shas(u3_atom sal, + u3_atom ruz) + { + c3_w sal_w, ruz_w; + c3_y *sal_y, *ruz_y, out_y[32]; + + sal_y = u3r_bytes_all(&sal_w, sal); + ruz_y = u3r_bytes_all(&ruz_w, ruz); + urcrypt_shas(sal_y, sal_w, ruz_y, ruz_w, out_y); + u3a_free(sal_y); + u3a_free(ruz_y); + return u3i_bytes(32, out_y); + } + + u3_noun + u3we_shax(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 _cqe_shax(a); + } + } + + u3_noun + u3we_shay(u3_noun cor) + { + u3_noun a, b; + + if ( (u3_none == (a = u3r_at(u3x_sam_2, cor))) || + (u3_none == (b = u3r_at(u3x_sam_3, cor))) || + (c3n == u3ud(a)) || + (c3n == u3ud(b)) ) + { + return u3m_bail(c3__exit); + } else { + return _cqe_shay(a, b); + } + } + + u3_noun + u3we_shal(u3_noun cor) + { + u3_noun a, b; + + if ( (u3_none == (a = u3r_at(u3x_sam_2, cor))) || + (u3_none == (b = u3r_at(u3x_sam_3, cor))) || + (c3n == u3ud(a)) || + (c3n == u3ud(b)) ) + { + return u3m_bail(c3__exit); + } else { + return _cqe_shal(a, b); + } + } + + u3_noun + u3we_shas(u3_noun cor) + { + u3_noun sal, ruz; + + if ( (u3_none == (sal = u3r_at(u3x_sam_2, cor))) || + (u3_none == (ruz = u3r_at(u3x_sam_3, cor))) || + (c3n == u3ud(sal)) || + (c3n == u3ud(ruz)) ) + { + return u3m_bail(c3__exit); + } else { + return _cqe_shas(sal, ruz); + } + } + + static u3_noun + _og_list(u3_noun a, + u3_noun b, + u3_noun c) + { + u3_noun l = u3_nul; + + if ( !_(u3a_is_cat(b)) ) { + return u3m_bail(c3__fail); + } + while ( 0 != b ) { + u3_noun x = u3qc_mix(a, c); + u3_noun y = u3qc_mix(b, x); + u3_noun d = _cqe_shas(c3_s4('o','g','-','b'), y); + u3_noun m; + + u3z(x); u3z(y); + + if ( b < 256 ) { + u3_noun e = u3qc_end(0, b, d); + + u3z(d); + m = u3nc(b, e); + b = 0; + } else { + m = u3nc(256, d); + c = d; + + b -= 256; + } + l = u3nc(m, l); + } + return u3kb_flop(l); + } + + u3_noun + u3qeo_raw(u3_atom a, + u3_atom b) + { + u3_noun x = u3qc_mix(b, a); + u3_noun c = _cqe_shas(c3_s4('o','g','-','a'), x); + u3_noun l = _og_list(a, b, c); + u3_noun r = u3qc_can(0, l); + + u3z(l); + u3z(c); + u3z(x); + + return r; + } + + u3_noun + u3weo_raw(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam, &b, u3x_con_sam, &a, 0) ) { + return u3m_bail(c3__exit); + } else { + return u3qeo_raw(a, b); + } + } diff --git a/vere/pkg/noun/jets/e/slaw.c b/vere/pkg/noun/jets/e/slaw.c new file mode 100644 index 0000000..906b0d7 --- /dev/null +++ b/vere/pkg/noun/jets/e/slaw.c @@ -0,0 +1,477 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +#include <ctype.h> + +static inline u3_noun +_parse_ud(u3_noun a) +{ + u3_weak pro; + + if ( u3_none == (pro = u3s_sift_ud(u3x_atom(a))) ) { + return u3_nul; + } + + return u3nc(u3_nul, pro); +} + +static +u3_noun get_syllable(c3_c** cur_ptr, c3_c* one, c3_c* two, c3_c* three) { + if (islower((*cur_ptr)[0]) && islower((*cur_ptr)[1]) && + islower((*cur_ptr)[2])) { + *one = (*cur_ptr)[0]; + *two = (*cur_ptr)[1]; + *three = (*cur_ptr)[2]; + (*cur_ptr) += 3; + return c3y; + } else { + return c3n; + } +} + +static u3_noun +combine(u3_noun p, u3_noun q) +{ + if ( (c3y == u3a_is_atom(p)) || (c3y == u3a_is_atom(q)) ) { + return 0; + } + + u3_noun lef = u3qa_mul(256, u3t(q)); + u3_noun ret = u3nc(0, u3qa_add(u3t(p), lef)); + u3z(lef); + u3z(p); u3z(q); + + return ret; +} + +#define ENSURE_NOT_END() do { \ + if (*cur == 0) { \ + u3a_free(c); \ + return u3_none; \ + } \ + } while (0) + +#define CONSUME(x) do { \ + if (*cur != x) { \ + u3a_free(c); \ + return u3_none; \ + } \ + cur++; \ + } while (0) + +#define TRY_GET_SYLLABLE(prefix) \ + c3_c prefix##_one, prefix##_two, prefix##_three; \ + if (c3n == get_syllable(&cur, & prefix##_one, & prefix##_two, & prefix##_three)) { \ + u3a_free(c); \ + return u3_none; \ + } + +u3_noun +_parse_p(u3_noun cor, u3_noun txt) { + c3_c* c = u3a_string(txt); + + c3_c* cur = c; + CONSUME('~'); + + // We at least have a sig prefix. We're now going to parse tuples of three + // lowercase letters. Our naming pattern for the pieces we read is [a b c d + // ...] as we read them. + TRY_GET_SYLLABLE(a); + + // There was only one syllable. If it's a valid suffix syllable, then + // it's a galaxy. We don't even have to run this through the scrambler or + // check for validity since its already a (unit @). + if (*cur == 0) { + u3a_free(c); + return u3_po_find_suffix(a_one, a_two, a_three); + } + + TRY_GET_SYLLABLE(b); + + // There were only two syllables. If they are a valid prefix and suffix, then + // it's a star. + if (*cur == 0) { + u3_noun a_part = u3_po_find_prefix(a_one, a_two, a_three); + u3_noun b_part = u3_po_find_suffix(b_one, b_two, b_three); + u3_atom combined = combine(b_part, a_part); + u3a_free(c); + return combined; + } + + // There must now be a - or it is invalid + CONSUME('-'); + + TRY_GET_SYLLABLE(c); + + ENSURE_NOT_END(); + + TRY_GET_SYLLABLE(d); + + if (*cur == 0) { + u3_noun a_part = u3_po_find_prefix(a_one, a_two, a_three); + u3_noun b_part = u3_po_find_suffix(b_one, b_two, b_three); + u3_noun c_part = u3_po_find_prefix(c_one, c_two, c_three); + u3_noun d_part = u3_po_find_suffix(d_one, d_two, d_three); + + u3_noun m = combine(d_part, combine(c_part, combine(b_part, a_part))); + u3a_free(c); + + if (_(u3a_is_atom(m))) { + return 0; + } + + u3_atom raw = u3k(u3t(m)); + u3z(m); + + u3_noun ob = u3j_cook("u3we_slaw_ob_p", u3k(cor), "ob"); + u3_noun hok = u3j_cook("u3we_slaw_fynd_p", ob, "fynd"); + return u3nc(0, u3n_slam_on(hok, raw)); + } + + // There must now be a - or it is invalid. + CONSUME('-'); + + // The next possible case is a "short" moon. (~ab-cd-ef) + TRY_GET_SYLLABLE(e); + + ENSURE_NOT_END(); + + TRY_GET_SYLLABLE(f); + + if (*cur == 0) { + u3_noun a_part = u3_po_find_prefix(a_one, a_two, a_three); + u3_noun b_part = u3_po_find_suffix(b_one, b_two, b_three); + u3_noun c_part = u3_po_find_prefix(c_one, c_two, c_three); + u3_noun d_part = u3_po_find_suffix(d_one, d_two, d_three); + u3_noun e_part = u3_po_find_prefix(e_one, e_two, e_three); + u3_noun f_part = u3_po_find_suffix(f_one, f_two, f_three); + + u3_noun m = combine(f_part, combine(e_part, combine(d_part, + combine(c_part, combine(b_part, a_part))))); + u3a_free(c); + + if (_(u3a_is_atom(m))) { + return 0; + } + + u3_atom raw = u3k(u3t(m)); + u3z(m); + u3_noun ob = u3j_cook("u3we_slaw_ob_p", u3k(cor), "ob"); + u3_noun hok = u3j_cook("u3we_slaw_fynd_p", ob, "fynd"); + return u3nc(0, u3n_slam_on(hok, raw)); + } + + // There must now be a - or it is invalid. + CONSUME('-'); + + // The next possible case is a "long" moon. (~ab-cd-ef-gh) + TRY_GET_SYLLABLE(g); + + ENSURE_NOT_END(); + + TRY_GET_SYLLABLE(h); + + if (*cur == 0) { + u3_noun a_part = u3_po_find_prefix(a_one, a_two, a_three); + u3_noun b_part = u3_po_find_suffix(b_one, b_two, b_three); + u3_noun c_part = u3_po_find_prefix(c_one, c_two, c_three); + u3_noun d_part = u3_po_find_suffix(d_one, d_two, d_three); + u3_noun e_part = u3_po_find_prefix(e_one, e_two, e_three); + u3_noun f_part = u3_po_find_suffix(f_one, f_two, f_three); + u3_noun g_part = u3_po_find_prefix(g_one, g_two, g_three); + u3_noun h_part = u3_po_find_suffix(h_one, h_two, h_three); + + u3_noun m = combine(h_part, combine(g_part, combine(f_part, + combine(e_part, combine(d_part, combine(c_part, + combine(b_part, a_part))))))); + u3a_free(c); + + if (_(u3a_is_atom(m))) { + return 0; + } + + u3_atom raw = u3k(u3t(m)); + u3z(m); + u3_noun ob = u3j_cook("u3we_slaw_ob_p", u3k(cor), "ob"); + u3_noun hok = u3j_cook("u3we_slaw_fynd_p", ob, "fynd"); + return u3nc(0, u3n_slam_on(hok, raw)); + } + + // At this point, the only thing it could be is a long comet, of the form + // ~ab-cd-ef-gh--ij-kl-mn-op + + CONSUME('-'); + CONSUME('-'); + + TRY_GET_SYLLABLE(i); + ENSURE_NOT_END(); + TRY_GET_SYLLABLE(j); + CONSUME('-'); + TRY_GET_SYLLABLE(k); + ENSURE_NOT_END(); + TRY_GET_SYLLABLE(l); + CONSUME('-'); + TRY_GET_SYLLABLE(m); + ENSURE_NOT_END(); + TRY_GET_SYLLABLE(n); + CONSUME('-'); + TRY_GET_SYLLABLE(o); + ENSURE_NOT_END(); + TRY_GET_SYLLABLE(p); + + if (*cur != 0) { + // We've parsed all of a comet shape, and there's still more in the + // string. Bail back to the interpreter. + u3a_free(c); + return u3_none; + } + + // We have a long comet. Time to jam it all together. We rely on combine() + // for the error checking and we don't have to scramble comet names. + u3_noun a_part = u3_po_find_prefix(a_one, a_two, a_three); + u3_noun b_part = u3_po_find_suffix(b_one, b_two, b_three); + u3_noun c_part = u3_po_find_prefix(c_one, c_two, c_three); + u3_noun d_part = u3_po_find_suffix(d_one, d_two, d_three); + u3_noun e_part = u3_po_find_prefix(e_one, e_two, e_three); + u3_noun f_part = u3_po_find_suffix(f_one, f_two, f_three); + u3_noun g_part = u3_po_find_prefix(g_one, g_two, g_three); + u3_noun h_part = u3_po_find_suffix(h_one, h_two, h_three); + u3_noun i_part = u3_po_find_prefix(i_one, i_two, i_three); + u3_noun j_part = u3_po_find_suffix(j_one, j_two, j_three); + u3_noun k_part = u3_po_find_prefix(k_one, k_two, k_three); + u3_noun l_part = u3_po_find_suffix(l_one, l_two, l_three); + u3_noun m_part = u3_po_find_prefix(m_one, m_two, m_three); + u3_noun n_part = u3_po_find_suffix(n_one, n_two, n_three); + u3_noun o_part = u3_po_find_prefix(o_one, o_two, o_three); + u3_noun p_part = u3_po_find_suffix(p_one, p_two, p_three); + + u3a_free(c); + + return combine(p_part, combine(o_part, combine(n_part, combine(m_part, + combine(l_part, combine(k_part, combine(j_part, combine(i_part, + combine(h_part, combine(g_part, combine(f_part, combine(e_part, + combine(d_part, combine(c_part, combine(b_part, a_part))))))))))))))); +} + +#define PARSE_NONZERO_NUMBER(numname) \ + c3_w numname = 0; \ + do { \ + if (cur[0] > '9' || cur[0] < '1') { \ + u3a_free(c); \ + return u3_none; \ + } \ + numname = cur[0] - '0'; \ + cur++; \ + while (isdigit(cur[0])) { \ + numname = u3ka_mul(numname, 10); \ + numname = u3ka_add(numname, cur[0] - '0'); \ + cur++; \ + } \ + } while (0) + +#define PARSE_INCLUDING_ZERO_NUMBER(numname) \ + c3_w numname = 0; \ + do { \ + if (cur[0] > '9' || cur[0] < '0') { \ + u3a_free(c); \ + return u3_none; \ + } \ + numname = cur[0] - '0'; \ + cur++; \ + while (isdigit(cur[0])) { \ + numname = u3ka_mul(numname, 10); \ + numname = u3ka_add(numname, cur[0] - '0'); \ + cur++; \ + } \ + } while (0) + +#define PARSE_HEX_DIGIT(out) \ + do { \ + if (cur[0] >= '0' && cur[0] <= '9') { \ + out = cur[0] - '0'; \ + } else if (cur[0] >= 'a' && cur[0] <= 'f') { \ + out = 10 + cur[0] - 'a'; \ + } else { \ + u3a_free(c); \ + return u3_none; \ + } \ + cur++; \ + } while(0) + + +u3_noun +_parse_da(u3_noun cor, u3_noun txt) { + c3_c* c = u3a_string(txt); + + c3_c* cur = c; + CONSUME('~'); + + // Parse out an arbitrary year number. Starts with a nonzero digit followed + // by a series of any digits. + PARSE_NONZERO_NUMBER(year); + + // Parse the optional negative sign for BC dates. + u3_noun bc = c3y; + if (cur[0] == '-') { + bc = c3n; + cur++; + } + + CONSUME('.'); + + // Parse out a two digit month (mot:ag). Either a single digit 1-9 or 1[012]. + c3_y month; + if (cur[0] == '1') { + if (cur[1] <= '2' && cur[1] >= '0') { + // This is a two number month. + month = 10 + cur[1] - '0'; + cur += 2; + } else { + // This is January. + month = 1; + cur++; + } + } else if (cur[0] <= '9' && cur[0] >= '2') { + month = cur[0] - '0'; + cur++; + } else { + u3a_free(c); + return u3_none; + } + + CONSUME('.'); + + // Parse out a two digit day (dip:ag). This number can be really big, so we + // can track number of days since September 1993. + PARSE_NONZERO_NUMBER(day); + + if (cur[0] == 0) { + u3a_free(c); + u3_noun hok = u3j_cook("u3we_slaw_parse_da", u3k(cor), "year"); + u3_noun res = u3n_slam_on(hok, + u3nt(u3nc(bc, year), month, + u3nc(day, u3nq(0, 0, 0, 0)))); + return u3nc(0, res); + } + + CONSUME('.'); + CONSUME('.'); + + PARSE_INCLUDING_ZERO_NUMBER(hour); + CONSUME('.'); + PARSE_INCLUDING_ZERO_NUMBER(minute); + CONSUME('.'); + PARSE_INCLUDING_ZERO_NUMBER(second); + + if (cur[0] == 0) { + u3a_free(c); + u3_noun hok = u3j_cook("u3we_slaw_parse_da", u3k(cor), "year"); + u3_noun res = u3n_slam_on(hok, + u3nt(u3nc(bc, year), month, + u3nc(day, u3nq(hour, minute, second, 0)))); + return u3nc(0, res); + } + + CONSUME('.'); + CONSUME('.'); + + // Now we have to parse a list of hexidecimal numbers 0-f of length 4 only + // (zero padded otherwise) separated by dots. + u3_noun list = 0; + while (1) { + // Parse 4 hex digits + c3_y one, two, three, four; + PARSE_HEX_DIGIT(one); + PARSE_HEX_DIGIT(two); + PARSE_HEX_DIGIT(three); + PARSE_HEX_DIGIT(four); + + c3_w current = (one << 12) + (two << 8) + (three << 4) + four; + list = u3nc(u3i_words(1, ¤t), list); + + if (cur[0] == 0) { + u3a_free(c); + + u3_noun flopped = u3qb_flop(list); + u3z(list); + + u3_noun hok = u3j_cook("u3we_slaw_parse_da", u3k(cor), "year"); + u3_noun res = u3n_slam_on(hok, + u3nt(u3nc(bc, year), month, + u3nc(day, + u3nq(hour, minute, second, flopped)))); + return u3nc(0, res); + } + + CONSUME('.'); + } +} + +#undef ENSURE_NOT_END +#undef CONSUME +#undef TRY_GET_SYLLABLE +#undef PARSE_NONZERO_NUMBER +#undef PARSE_HEX_DIGIT + +u3_noun +_parse_tas(u3_noun txt) { + // For any symbol which matches, txt will return itself as a + // value. Therefore, this is mostly checking validity. + c3_c* c = u3a_string(txt); + + // First character must represent a lowercase letter + c3_c* cur = c; + if (!islower(cur[0])) { + u3a_free(c); + return 0; + } + cur++; + + while (cur[0] != 0) { + if (!(islower(cur[0]) || isdigit(cur[0]) || cur[0] == '-')) { + u3a_free(c); + return 0; + } + + cur++; + } + + u3a_free(c); + return u3nc(0, u3k(txt)); +} + +u3_noun +u3we_slaw(u3_noun cor) +{ + u3_noun mod; + u3_noun txt; + + if (c3n == u3r_mean(cor, u3x_sam_2, &mod, + u3x_sam_3, &txt, 0)) { + return u3m_bail(c3__exit); + } + + switch (mod) { + case c3__da: + return _parse_da(cor, txt); + + case 'p': + return _parse_p(cor, txt); + + case c3__ud: + return _parse_ud(txt); + + // %ta is used once in link.hoon. don't bother. + + case c3__tas: + return _parse_tas(txt); + + default: + return u3_none; + } +} diff --git a/vere/pkg/noun/jets/e/tape.c b/vere/pkg/noun/jets/e/tape.c new file mode 100644 index 0000000..4d251b6 --- /dev/null +++ b/vere/pkg/noun/jets/e/tape.c @@ -0,0 +1,53 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + static u3_noun + _norm(u3_noun a) + { + if ( c3n == u3du(a) ) { + return u3_nul; + } else { + return u3nc(((c3y == u3du(u3h(a))) ? u3_nul : u3k(u3h(a))), + _norm(u3t(a))); + } + } + + static u3_noun + _good(u3_noun a) + { + while ( 1 ) { + if ( u3_nul == a ) { + return c3y; + } + if ( c3n == u3ud(u3h(a)) ) { + return c3n; + } + a = u3t(a); + } + } + + u3_noun + u3qe_tape(u3_noun a) + { + if ( c3y == _good(a) ) { + return u3k(a); + } else { + return _norm(a); + } + } + u3_noun + u3we_tape(u3_noun cor) + { + u3_noun a; + + if ( (u3_none == (a = u3r_at(u3x_sam, cor))) ) { + return u3m_bail(c3__fail); + } else { + return u3qe_tape(a); + } + } diff --git a/vere/pkg/noun/jets/e/trip.c b/vere/pkg/noun/jets/e/trip.c new file mode 100644 index 0000000..519a852 --- /dev/null +++ b/vere/pkg/noun/jets/e/trip.c @@ -0,0 +1,33 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qe_trip(u3_atom a) +{ + return u3qc_rip(3, 1, a); +} + +u3_noun +u3we_trip(u3_noun cor) +{ + u3_noun a = u3x_at(u3x_sam, cor); + + if ( c3n == u3ud(a) ) { + return u3m_bail(c3__exit); + } + + return u3qe_trip(a); +} + +u3_atom +u3ke_trip(u3_noun a) +{ + u3_atom pro = u3qe_trip(a); + u3z(a); + return pro; +} diff --git a/vere/pkg/noun/jets/e/urwasm.c b/vere/pkg/noun/jets/e/urwasm.c new file mode 100644 index 0000000..626aef3 --- /dev/null +++ b/vere/pkg/noun/jets/e/urwasm.c @@ -0,0 +1,3086 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +#include "wasm3.h" +#include "m3_env.h" + +// #define URWASM_SUBROAD +#define URWASM_STATEFUL + +#define ONCE_CTX 63 +#define RUN_CTX 7 + +#define AX_RUNNABLE 374 +#define AX_ARROWS 1502 + +#define AX_CALL 20 +#define AX_MEMREAD 383 +#define AX_MEMWRITE 94 +#define AX_CALL_EXT 375 +#define AX_GLOBAL_SET 4 +#define AX_GLOBAL_GET 22 +#define AX_MEM_SIZE 186 +#define AX_MEM_GROW 381 +#define AX_GET_ACC 374 +#define AX_SET_ACC 92 +#define AX_GET_ALL_GLOB 43 +#define AX_SET_ALL_GLOB 380 + +#define AX_TRY 43 +#define AX_CATCH 4 +#define AX_RETURN 20 +#define AX_FAIL 47 + +#define ARROW_CTX 511 +#define MONAD_CTX 127 + +#define arr_sam 62 +#define arr_sam_2 124 +#define arr_sam_3 125 +#define arr_sam_6 250 +#define arr_sam_7 251 + +#define seed_module 2 +#define seed_past 6 +#define seed_shop 14 +#define seed_import 15 + +#define uw__lia c3_s3('l', 'i', 'a') + +#define uw_lia_run_version 1 + +#define ERR(string) ("\r\n\033[31m>>> " string "\033[0m\r\n") +#define WUT(string) ("\r\n\033[33m>> " string "\033[0m\r\n") +#define DBG(string) ("\r\n" string "\r\n") + +#define KICK1(TRAP) uw_kick_nock(TRAP, 2) +#define KICK2(TRAP) KICK1(KICK1(TRAP)) + +// [a b c d e f g h] +static inline u3_noun +uw_octo(u3_noun a, + u3_noun b, + u3_noun c, + u3_noun d, + u3_noun e, + u3_noun f, + u3_noun g, + u3_noun h) +{ + return u3nc(a, u3nq(b, c, d, u3nq(e, f, g, h))); +} + +// kick by nock. axe RETAINED (ignore if direct) +static u3_noun +uw_kick_nock(u3_noun cor, u3_noun axe) +{ + u3_noun fol = u3x_at(axe, cor); + return u3n_nock_on(cor, u3k(fol)); +} + +// slam by nock +static u3_noun +uw_slam_nock(u3_noun gat, u3_noun sam) +{ + u3_noun cor = u3nc(u3k(u3h(gat)), u3nc(sam, u3k(u3t(u3t(gat))))); + u3z(gat); + return uw_kick_nock(cor, 2); +} + +static u3_noun +uw_slam_check(u3_noun gat, u3_noun sam, c3_t is_stateful) +{ + u3_noun bat = u3k(u3h(gat)); + u3_noun cor = u3nc(u3k(bat), u3nc(sam, u3k(u3t(u3t(gat))))); + u3z(gat); + + if (!is_stateful) + { + return u3n_nock_on(cor, bat); + } + else + { + u3_noun ton = u3n_nock_an(cor, bat); + + u3_noun tag, pro; + if (c3n == u3r_cell(ton, &tag, &pro)) + { + return u3m_bail(c3__fail); + } + if (0 == tag) + { + u3k(pro); + u3z(ton); + return pro; + } + else if (2 == tag) + { + return u3m_bail(c3__exit); + } + else + { + return u3m_bail(c3__fail); + } + } +} + +static inline void +_push_list(u3_noun som, u3_noun *lit) +{ + if (u3_none == *lit) + { + u3z(som); + } + else + { + *lit = u3nc(som, *lit); + } +} + +static inline u3_weak +_pop_list(u3_weak *lit) +{ + if (u3_none == *lit) + { + return u3_none; + } + u3_noun hed, tel; + if (c3n == u3r_cell(*lit, &hed, &tel)) + { + return u3m_bail(c3__fail); + } + u3k(hed); + u3k(tel); + u3z(*lit); + *lit = tel; + return hed; +} + +static const M3Result UrwasmArrowExit = "An imported arrow returned %2"; + +static const c3_m uw_run_m = uw__lia + c3__run + uw_lia_run_version; + +static_assert( + (c3y == u3a_is_cat(uw_run_m)), + "u3we_run key tag must be a direct atom" +); + +typedef struct { + u3_noun call_bat; + u3_noun memread_bat; + u3_noun memwrite_bat; + u3_noun call_ext_bat; + u3_noun try_bat; + u3_noun catch_bat; + u3_noun return_bat; + u3_noun fail_bat; + u3_noun global_set_bat; + u3_noun global_get_bat; + u3_noun mem_grow_bat; + u3_noun mem_size_bat; + u3_noun get_acc_bat; + u3_noun set_acc_bat; + u3_noun get_all_glob_bat; + u3_noun set_all_glob_bat; +// + u3_noun call_ctx; + u3_noun memread_ctx; + u3_noun memwrite_ctx; + u3_noun global_set_ctx; + u3_noun global_get_ctx; + u3_noun mem_grow_ctx; + u3_noun mem_size_ctx; + u3_noun get_all_glob_ctx; + u3_noun set_all_glob_ctx; +} match_data_struct; + +// memory arena with exponential growth +typedef struct { + c3_w siz_w; // size in bytes + c3_y pad_y; // alignment padding + c3_t ini_t; // already initialized + u3i_slab sab_u; // associated slab + c3_y* buf_y; // allocated buffer + c3_y* nex_y; // next allocation + c3_y* end_y; // end of arena + jmp_buf* esc_u; // escape buffer +} uw_arena; + +typedef struct { + IM3Module wasm_module; // p + u3_noun lia_shop; // q, transferred + u3_noun acc; // p.r, transferred + u3_noun map; // q.r, retained + match_data_struct* match; + u3_noun arrow_yil; // transferred + u3_noun susp_list; // transferred + u3_noun resolution; // resolved %1 block, transferred + uw_arena box_arena; + uw_arena code_arena; + u3_noun yil_previous; // transferred + u3_noun queue; // transferred + c3_t is_stateful; +} lia_state; + +typedef enum { + west_call, + west_call_ext, + west_try, + west_catch_try, + west_catch_err, + west_link_wasm, +} wasm3_ext_suspend_tag; + +typedef enum { + lst_call = 0, + // lst_call_ext = 1, // not necessary + lst_try = 2, + lst_catch_try = 3, + lst_catch_err = 4, + lst_link_wasm = 5, +} lia_suspend_tag; + +static void +_uw_arena_init_size(uw_arena* ren_u, c3_w siz_w) +{ + ren_u->siz_w = siz_w; + u3i_slab_init(&ren_u->sab_u, 3, siz_w + 12); // size + max padding + ren_u->buf_y = ren_u->nex_y = c3_align(ren_u->sab_u.buf_y, 16, C3_ALGHI); + ren_u->end_y = ren_u->buf_y + ren_u->siz_w; + c3_y pad_y = ren_u->buf_y - ren_u->sab_u.buf_y; + if (pad_y > 12) + { + u3m_bail(c3__fail); + } + ren_u->pad_y = pad_y; + ren_u->ini_t = 1; +} + +static void +_uw_arena_init(uw_arena* ren_u) +{ + _uw_arena_init_size(ren_u, (c3_w)1 << 23); +} + +static void +_uw_arena_grow(uw_arena* ren_u) +{ + if (!ren_u->ini_t) + { + u3m_bail(c3__fail); + } + c3_w new_w = ren_u->siz_w * 2; + if (new_w / 2 != ren_u->siz_w) + { + u3m_bail(c3__fail); + } + ren_u->siz_w = new_w; + + u3i_slab_free(&ren_u->sab_u); + + u3i_slab_init(&ren_u->sab_u, 3, new_w + 12); // size + max padding + ren_u->buf_y = ren_u->nex_y = c3_align(ren_u->sab_u.buf_y, 16, C3_ALGHI); + ren_u->end_y = ren_u->nex_y + new_w; + c3_y pad_y = ren_u->nex_y - ren_u->sab_u.buf_y; + if (pad_y > 12) + { + u3m_bail(c3__fail); + } + ren_u->pad_y = pad_y; +} + +static void +_uw_arena_reset(uw_arena* ren_u) +{ + if (!ren_u->ini_t) + { + u3m_bail(c3__fail); + } + ren_u->nex_y = ren_u->buf_y; + memset(ren_u->buf_y, 0, (size_t)ren_u->siz_w); +} + +static void +_uw_arena_free(uw_arena* ren_u) +{ + if (!ren_u->ini_t) + { + u3m_bail(c3__fail); + } + u3i_slab_free(&ren_u->sab_u); + ren_u->ini_t = 0; +} + +// Code page allocation: simple bump allocator for non-growing objects, +// i.e. code pages +// save allocation length for realloc +// CodeArena->esc_u MUST be initialized by the caller to handle OOM +// +static uw_arena* CodeArena; + +static void* +_calloc_code(size_t num_i, size_t len_i) +{ + if (!CodeArena->ini_t) + { + u3m_bail(c3__fail); + } + + void* lag_v = CodeArena->nex_y; + + size_t byt_i = num_i * len_i; + if (byt_i / len_i != num_i) + { + u3m_bail(c3__fail); + } + + if (byt_i >= UINT64_MAX - 16) + { + u3m_bail(c3__fail); + } + c3_d byt_d = byt_i + 16; // c3_d for length + alignment padding + + c3_y* nex_y = CodeArena->nex_y + byt_d; + nex_y = c3_align(nex_y, 16, C3_ALGHI); + + if (nex_y >= CodeArena->end_y) + { // OOM, jump out to increase the arena size and try again + _longjmp(*CodeArena->esc_u, c3__code); + } + + *((c3_d*)lag_v) = byt_d - 16; // corruption check + *((c3_d*)lag_v + 1) = byt_d - 16; + + CodeArena->nex_y = nex_y; + return ((c3_d*)lag_v + 2); +} + +static void* +_realloc_code(void* lag_v, size_t len_i) +{ + if (!CodeArena->ini_t) + { + u3m_bail(c3__fail); + } + if (!lag_v) + { + return _calloc_code(len_i, 1); + } + c3_d old1_d = *((c3_d*)lag_v - 1); + c3_d old2_d = *((c3_d*)lag_v - 2); + if (old1_d != old2_d) + { + u3m_bail(c3__fail); + } + if (len_i >= UINT64_MAX) + { + u3m_bail(c3__fail); + } + c3_d len_d = len_i; + void* new_v = _calloc_code(len_d, 1); + memcpy(new_v, lag_v, c3_min(len_d, old1_d)); + + return new_v; +} + +static void +_free_code(void* lag_v) +{ + if (!CodeArena->ini_t) + { + u3m_bail(c3__fail); + } + // noop +} + +// Struct/array allocation: [len_d cap_d data] +// BoxArena->esc_u MUST be initialized by the caller to handle OOM +// +static uw_arena* BoxArena; + +// allocate with capacity +// the allocated buffer +static void* +_malloc_box_cap(c3_d len_d, c3_d cap_d) +{ + if (!BoxArena->ini_t) + { + u3m_bail(c3__fail); + } + + void* lag_v = BoxArena->nex_y; + + if (cap_d >= UINT64_MAX - 16) + { + u3m_bail(c3__fail); + } + c3_d pac_d = cap_d + 16; // c3_d for length + capacity + + c3_y* nex_y = BoxArena->nex_y + pac_d; + nex_y = c3_align(nex_y, 16, C3_ALGHI); + + if (nex_y >= BoxArena->end_y) + { // OOM, jump out to increase the arena size and try again + _longjmp(*BoxArena->esc_u, c3__box); + } + + *((c3_d*)lag_v) = len_d; + *((c3_d*)lag_v + 1) = cap_d; + + BoxArena->nex_y = nex_y; + return ((c3_d*)lag_v + 2); +} + +static void* +_calloc_box(size_t num_i, size_t len_i) +{ + size_t byt_i = num_i * len_i; + if (byt_i / len_i != num_i) + { + u3m_bail(c3__fail); + } + if (byt_i > UINT64_MAX - 16) + { + u3m_bail(c3__fail); + } + c3_d byt_d = byt_i; + return _malloc_box_cap(byt_d, byt_d); +} + +static void* +_realloc_box(void* lag_v, size_t len_i) +{ + if (!BoxArena->ini_t) + { + u3m_bail(c3__fail); + } + if (!lag_v) + { + return _calloc_box(len_i, 1); + } + c3_d old_d = *((c3_d*)lag_v - 2); + c3_d cap_d = *((c3_d*)lag_v - 1); + if (len_i >= UINT64_MAX) + { + u3m_bail(c3__fail); + } + c3_d len_d = len_i; + if (len_d <= cap_d) + { + *((c3_d*)lag_v - 2) = len_d; + return lag_v; + } + + // while (cap_d <= len_d) + // { + // cap_d *= 2; + // } + cap_d <<= c3_bits_dabl(len_d) - c3_bits_dabl(cap_d); + cap_d <<= (cap_d <= len_d); + + // overflow check + if (cap_d <= len_d) + u3m_bail(c3__fail); + + void* new_v = _malloc_box_cap(len_d, cap_d); + memcpy(new_v, lag_v, old_d); + + return new_v; +} + +static void +_free_box(void* lag_v) +{ + if (!BoxArena->ini_t) + { + u3m_bail(c3__fail); + } + // noop +} + +// bailing allocator to prevent wasm3 from touching the arenas + +static void* +_calloc_bail(size_t num_i, size_t len_i) +{ + u3m_bail(c3__fail); +} + +static void* +_realloc_bail(void* lag_v, size_t len_i) +{ + u3m_bail(c3__fail); +} + +static void +_free_bail(void* lag_v) +{ + u3m_bail(c3__fail); +} + + +static u3_noun +_atoms_from_stack(void** valptrs, c3_w n, c3_y* types) +{ + u3_noun out = u3_nul; + while (n--) + { + switch (types[n]) + { // TODO 64 bit vere + case c_m3Type_i32: + case c_m3Type_f32: + { + out = u3nc(u3i_word(*(c3_w*)valptrs[n]), out); + break; + } + case c_m3Type_i64: + case c_m3Type_f64: + { + out = u3nc(u3i_chub(*(c3_d*)valptrs[n]), out); + break; + } + default: + { + return u3m_bail(c3__fail); + } + } + } + return out; +} + +// RETAIN argument +static c3_o +_atoms_to_stack(u3_noun atoms, void** valptrs, c3_w n, c3_y* types) +{ + for (c3_w i = 0; i < n; i++) + { + if (c3y == u3ud(atoms)) + { + return c3n; + } + u3_noun atom; + u3x_cell(atoms, &atom, &atoms); + if (c3n == u3ud(atom)) + { + return u3m_bail(c3__fail); + } + switch (types[i]) + { + case c_m3Type_i32: + case c_m3Type_f32: + { + *(c3_w*)valptrs[i] = u3r_word(0, atom); + break; + } + case c_m3Type_i64: + case c_m3Type_f64: + { + *(c3_d*)valptrs[i] = u3r_chub(0, atom); + break; + } + default: + { + return u3m_bail(c3__fail); + } + } + } + return __(u3_nul == atoms); +} + +static u3_noun +_coins_from_stack(void** valptrs, c3_w n, c3_y* types) +{ + u3_noun out = u3_nul; + while (n--) + { + switch (types[n]) + { // TODO 64 bit vere + case c_m3Type_i32: + { + out = u3nc(u3nc(c3__i32, u3i_word(*(c3_w*)valptrs[n])), out); + break; + } + case c_m3Type_i64: + { + out = u3nc(u3nc(c3__i64, u3i_chub(*(c3_d*)valptrs[n])), out); + break; + } + case c_m3Type_f32: + { + out = u3nc(u3nc(c3__f32, u3i_word(*(c3_w*)valptrs[n])), out); + break; + } + case c_m3Type_f64: + { + out = u3nc(u3nc(c3__f64, u3i_chub(*(c3_d*)valptrs[n])), out); + break; + } + default: + { + return u3m_bail(c3__fail); + } + } + } + return out; +} + +// RETAIN argument +static c3_o +_coins_to_stack(u3_noun coins, void** valptrs, c3_w n, c3_y* types) +{ + for (c3_w i = 0; i < n; i++) + { + if (c3y == u3ud(coins)) + { + return c3n; + } + u3_noun coin; + u3x_cell(coins, &coin, &coins); + if (c3y == u3ud(coin)) + { + return u3m_bail(c3__fail); + } + u3_noun tag, value; + u3x_cell(coin, &tag, &value); + if (c3n == u3ud(value)) + { + return u3m_bail(c3__fail); + } + switch (types[i]) + { + case c_m3Type_i32: + { + if (c3__i32 != tag) + { + return c3n; + } + *(c3_w*)valptrs[i] = u3r_word(0, value); + break; + } + case c_m3Type_i64: + { + if (c3__i64 != tag) + { + return c3n; + } + *(c3_d*)valptrs[i] = u3r_chub(0, value); + break; + } + case c_m3Type_f32: + { + if (c3__f32 != tag) + { + return c3n; + } + *(c3_w*)valptrs[i] = u3r_word(0, value); + break; + } + case c_m3Type_f64: + { + if (c3__f64 != tag) + { + return c3n; + } + *(c3_d*)valptrs[i] = u3r_chub(0, value); + break; + } + default: + { + return u3m_bail(c3__fail); + } + } + } + return __(u3_nul == coins); +} + +static c3_t +_deterministic_trap(M3Result result) +{ + return ( result == m3Err_trapOutOfBoundsMemoryAccess + || result == m3Err_trapDivisionByZero + || result == m3Err_trapIntegerOverflow + || result == m3Err_trapIntegerConversion + || result == m3Err_trapIndirectCallTypeMismatch + || result == m3Err_trapTableIndexOutOfRange + || result == m3Err_trapTableElementIsNull + || result == UrwasmArrowExit + ); +} + +static u3_noun +_reduce_monad(u3_noun monad, lia_state* sat_u) +{ + u3_noun monad_bat = u3h(monad); + if (c3y == u3r_sing(monad_bat, sat_u->match->call_bat)) + { + if (c3n == u3r_sing(u3at(ARROW_CTX, monad), sat_u->match->call_ctx)) + { + return u3m_bail(c3__fail); + } + // call + u3_atom name = u3x_atom(u3at(arr_sam_2, monad)); + u3_noun args = u3at(arr_sam_3, monad); + + c3_w met_w = u3r_met(3, name); + c3_c* name_c = u3a_malloc(met_w + 1); + u3r_bytes(0, met_w, (c3_y*)name_c, name); + name_c[met_w] = 0; + + M3Result result; + + IM3Function f; + result = m3_FindFunction(&f, sat_u->wasm_module->runtime, name_c); + + if (result) + { + fprintf(stderr, ERR("function %s search error: %s"), name_c, result); + return u3m_bail(c3__fail); + } + + c3_w n_in = f->funcType->numArgs; + c3_w n_out = f->funcType->numRets; + c3_y* types = f->funcType->types; + + c3_d *vals_in = u3a_calloc(n_in, sizeof(c3_d)); + void **valptrs_in = u3a_calloc(n_in, sizeof(void*)); + for (c3_w i = 0; i < n_in; i++) + { + valptrs_in[i] = &vals_in[i]; + } + + c3_d *vals_out = u3a_calloc(n_out, sizeof(c3_d)); + void **valptrs_out = u3a_calloc(n_out, sizeof(void*)); + for (c3_w i = 0; i < n_out; i++) + { + valptrs_out[i] = &vals_out[i]; + } + + if (c3n == _atoms_to_stack(args, valptrs_in, n_in, (types+n_out))) + { + fprintf(stderr, ERR("function %s wrong number of args"), name_c); + return u3m_bail(c3__fail); + } + + c3_w edge_1 = sat_u->wasm_module->runtime->edge_suspend; + + // printf("\r\n\r\n invoke %s\r\n\r\n", name_c); + + { // push on suspend stacks + c3_d f_idx_d = f - sat_u->wasm_module->functions; + m3_SuspendStackPush64(sat_u->wasm_module->runtime, f_idx_d); + m3_SuspendStackPush64(sat_u->wasm_module->runtime, west_call); + m3_SuspendStackPushExtTag(sat_u->wasm_module->runtime); + _push_list( + u3nc(lst_call, u3k(name)), + &sat_u->susp_list + ); + } + + M3Result result_call = m3_Call(f, n_in, (const void**)valptrs_in); + // printf("\r\n done %s\r\n", name_c); + + if (result_call != m3Err_ComputationBlock + && result_call != m3Err_SuspensionError) + { // pop suspend stacks + m3_SuspendStackPopExtTag(sat_u->wasm_module->runtime); + c3_d tag; + m3_SuspendStackPop64(sat_u->wasm_module->runtime, &tag); + if (tag != -1 && tag != west_call) + { + printf(ERR("call tag mismatch: %"PRIc3_d), tag); + return u3m_bail(c3__fail); + } + m3_SuspendStackPop64(sat_u->wasm_module->runtime, NULL); + u3_noun frame = _pop_list(&sat_u->susp_list); + if (u3_none != frame && lst_call != u3h(frame)) + { + printf(ERR("wrong frame: call")); + return u3m_bail(c3__fail); + } + u3z(frame); + } + + u3_noun yil; + if (result_call == m3Err_ComputationBlock) + { + yil = sat_u->arrow_yil; + sat_u->arrow_yil = u3_none; + if (yil == u3_none) + { + return u3m_bail(c3__fail); + } + } + else if (_deterministic_trap(result_call)) + { + fprintf(stderr, WUT("%s call trapped: %s"), name_c, result_call); + yil = u3nc(2, 0); + } + else if (result_call == m3Err_functionImportMissing) + { + return u3m_bail(c3__exit); + } + else if (result_call) + { + fprintf(stderr, ERR("%s call failed: %s"), name_c, result_call); + return u3m_bail(c3__fail); + } + else + { + result = m3_GetResults(f, n_out, (const void**)valptrs_out); + if (result) + { + fprintf(stderr, ERR("function %s failed to get results"), name_c); + return u3m_bail(c3__fail); + } + yil = u3nc(0, _atoms_from_stack(valptrs_out, n_out, types)); + } + + c3_w edge_2 = sat_u->wasm_module->runtime->edge_suspend; + if (edge_1 != edge_2 && !result_call) + { + fprintf(stderr, ERR("imbalanced suspension stack on succesfull return: %d vs %d"), edge_1, edge_2); + return u3m_bail(c3__fail); + } + + u3a_free(name_c); + u3a_free(vals_in); + u3a_free(valptrs_in); + u3a_free(vals_out); + u3a_free(valptrs_out); + u3z(monad); + + return yil; + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->memread_bat)) + { + if (c3n == u3r_sing(u3at(ARROW_CTX, monad), sat_u->match->memread_ctx)) + { + return u3m_bail(c3__fail); + } + // memread + u3_atom ptr = u3x_atom(u3at(arr_sam_2, monad)); + u3_noun len = u3at(arr_sam_3, monad); + + c3_w ptr_w = u3r_word(0, ptr); + c3_l len_l = (c3y == u3a_is_cat(len)) ? len : u3m_bail(c3__fail); + c3_w len_buf_w; + c3_y* buf_y = m3_GetMemory(sat_u->wasm_module->runtime, &len_buf_w, 0); + + if (buf_y == NULL) + { + fprintf(stderr, ERR("memread failed to get memory")); + return u3m_bail(c3__fail); + } + + if (ptr_w + len_l > len_buf_w) + { + fprintf(stderr, ERR("memread out of bounds")); + return u3m_bail(c3__fail); + } + + u3z(monad); + return u3nt(0, len_l, u3i_bytes(len_l, (buf_y + ptr_w))); + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->memwrite_bat)) + { + if (c3n == u3r_sing(u3at(ARROW_CTX, monad), sat_u->match->memwrite_ctx)) + { + return u3m_bail(c3__fail); + } + // memwrite + u3_atom ptr = u3x_atom(u3at(arr_sam_2, monad)); + u3_noun len = u3at(arr_sam_6, monad); + u3_noun src = u3at(arr_sam_7, monad); + + c3_w ptr_w = u3r_word(0, ptr); + c3_l len_l = (c3y == u3a_is_cat(len)) ? len : u3m_bail(c3__fail); + + c3_w len_buf_w; + c3_y* buf_y = m3_GetMemory(sat_u->wasm_module->runtime, &len_buf_w, 0); + + if (buf_y == NULL) + { + fprintf(stderr, ERR("memwrite failed to get memory")); + return u3m_bail(c3__fail); + } + + if (ptr_w + len_l > len_buf_w) + { + fprintf(stderr, ERR("memwrite out of bounds")); + return u3m_bail(c3__fail); + } + + u3r_bytes(0, len_l, (buf_y + ptr_w), u3x_atom(src)); + + u3z(monad); + return u3nc(0, 0); + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->call_ext_bat)) + { + // call-ext + if (u3_nul == sat_u->lia_shop) + { + // Suspended computation will have exactly one blocking point, which + // must be at the top of the stack. You are at this point. + // There is no useful info to be saved here, name/args are not enough + // to qualify the external call, which can and will be nondeterministic + // (like all IO in urbit) + // + // On wasm3 side op_CallRaw will store the information about the + // called function. It shall be the top frame of the suspension stack, + // since only Lia can block, so wasm3 has to call Lia to get blocked. + // + // A frame is pushed in wasm3 to trigger the callback and signal to + // _apply_diff that the computation is blocked + // + m3_SuspendStackPush64(sat_u->wasm_module->runtime, west_call_ext); + m3_SuspendStackPushExtTag(sat_u->wasm_module->runtime); + + u3_noun name = u3at(arr_sam_2, monad); + u3_noun args = u3at(arr_sam_3, monad); + + u3_noun yil = u3nt(1, u3k(name), u3k(args)); + u3z(monad); + return yil; + } + else + { + u3z(monad); + + u3_noun lia_buy, tel; + u3x_cell(sat_u->lia_shop, &lia_buy, &tel); + u3_noun yil = u3nc(0, u3k(lia_buy)); + u3k(tel); + u3z(sat_u->lia_shop); + sat_u->lia_shop = tel; + return yil; + } + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->try_bat)) + { + // try + u3_noun monad_b = u3at(60, monad); + u3_noun cont = u3at(61, monad); + u3_weak yil; + u3_noun monad_cont; + { // push on suspend stacks + m3_SuspendStackPush64(sat_u->wasm_module->runtime, west_try); + m3_SuspendStackPushExtTag(sat_u->wasm_module->runtime); + _push_list(u3nc(lst_try, u3k(cont)), &sat_u->susp_list); + } + { + yil = _reduce_monad(u3k(monad_b), sat_u); + + if (1 != u3h(yil)) + { // pop suspend stacks + m3_SuspendStackPopExtTag(sat_u->wasm_module->runtime); + c3_d tag; + m3_SuspendStackPop64(sat_u->wasm_module->runtime, &tag); + if (tag != -1 && tag != west_try) + { + printf(ERR("try tag mismatch: %"PRIc3_d), tag); + return u3m_bail(c3__fail); + } + u3_noun frame = _pop_list(&sat_u->susp_list); + if (u3_none != frame && lst_try != u3h(frame)) + { + printf(ERR("wrong frame: try")); + return u3m_bail(c3__fail); + } + u3z(frame); + } + + if (0 == u3h(yil)) + { + // any unconstrained nock computation is a potential urwasm reentry: + // save the pointers before that, restore after + uw_arena* box_arena_frame = BoxArena; + uw_arena* code_arena_frame = CodeArena; + monad_cont = uw_slam_check( + u3k(cont), + u3k(u3t(yil)), + sat_u->is_stateful + ); + BoxArena = box_arena_frame; + CodeArena = code_arena_frame; + u3z(yil); + yil = u3_none; + } + } + + u3z(monad); + if (u3_none == yil) + { + return _reduce_monad(monad_cont, sat_u); + } + else + { + return yil; + } + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->catch_bat)) + { + // catch + u3_noun monad_try = u3at(120, monad); + u3_noun monad_catch = u3at(121, monad); + u3_noun cont = u3at(61, monad); + u3_weak yil; + u3_noun monad_cont; + + { + { // push on suspend stacks + m3_SuspendStackPush64(sat_u->wasm_module->runtime, west_catch_try); + m3_SuspendStackPushExtTag(sat_u->wasm_module->runtime); + _push_list( + u3nt(lst_catch_try, u3k(monad_catch), u3k(cont)), + &sat_u->susp_list + ); + } + yil = _reduce_monad(u3k(monad_try), sat_u); + + if (1 != u3h(yil)) + { // pop suspend stacks + m3_SuspendStackPopExtTag(sat_u->wasm_module->runtime); + c3_d tag; + m3_SuspendStackPop64(sat_u->wasm_module->runtime, &tag); + if (tag != -1 && tag != west_catch_try) + { + printf(ERR("catch-try tag mismatch: %"PRIc3_d), tag); + return u3m_bail(c3__fail); + } + u3_noun frame = _pop_list(&sat_u->susp_list); + if (u3_none != frame && lst_catch_try != u3h(frame)) + { + printf(ERR("wrong frame: catch-try")); + return u3m_bail(c3__fail); + } + u3z(frame); + } + + if (0 == u3h(yil)) + { + uw_arena* box_arena_frame = BoxArena; + uw_arena* code_arena_frame = CodeArena; + monad_cont = uw_slam_check( + u3k(cont), + u3k(u3t(yil)), + sat_u->is_stateful + ); + BoxArena = box_arena_frame; + CodeArena = code_arena_frame; + u3z(yil); + yil = u3_none; + } + else if (2 == u3h(yil)) + { + u3z(yil); + + { // push on suspend stacks + m3_SuspendStackPush64(sat_u->wasm_module->runtime, west_catch_err); + m3_SuspendStackPushExtTag(sat_u->wasm_module->runtime); + _push_list( + u3nc(lst_catch_err, u3k(cont)), + &sat_u->susp_list + ); + } + + yil = _reduce_monad(u3k(monad_catch), sat_u); + + if (1 != u3h(yil)) + { // pop suspend stacks + m3_SuspendStackPopExtTag(sat_u->wasm_module->runtime); + c3_d tag; + m3_SuspendStackPop64(sat_u->wasm_module->runtime, &tag); + if (tag != -1 && tag != west_catch_err) + { + printf(ERR("catch-err tag mismatch: %"PRIc3_d), tag); + return u3m_bail(c3__fail); + } + u3_noun frame = _pop_list(&sat_u->susp_list); + if (u3_none != frame && lst_catch_err != u3h(frame)) + { + printf(ERR("wrong frame: catch-err")); + return u3m_bail(c3__fail); + } + u3z(frame); + } + + if (0 == u3h(yil)) + { + uw_arena* box_arena_frame = BoxArena; + uw_arena* code_arena_frame = CodeArena; + monad_cont = uw_slam_check( + u3k(cont), + u3k(u3t(yil)), + sat_u->is_stateful + ); + BoxArena = box_arena_frame; + CodeArena = code_arena_frame; + u3z(yil); + yil = u3_none; + } + } + } + + u3z(monad); + if (u3_none == yil) + { + return _reduce_monad(monad_cont, sat_u); + } + else + { + return yil; + } + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->return_bat)) + { + // return + u3_noun yil = u3nc(0, u3k(u3at(30, monad))); + u3z(monad); + return yil; + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->global_set_bat)) + { + if (c3n == u3r_sing(u3at(ARROW_CTX, monad), sat_u->match->global_set_ctx)) + { + return u3m_bail(c3__fail); + } + // global-set + u3_atom name = u3x_atom(u3at(arr_sam_2, monad)); + u3_atom value = u3x_atom(u3at(arr_sam_3, monad)); + + c3_w met_w = u3r_met(3, name); + c3_c* name_c = u3a_malloc(met_w + 1); + u3r_bytes(0, met_w, (c3_y*)name_c, name); + name_c[met_w] = 0; + + IM3Global glob = m3_FindGlobal(sat_u->wasm_module, name_c); + + if (!glob) + { + fprintf(stderr, ERR("global %s not found"), name_c); + return u3m_bail(c3__fail); + } + + if (!glob->isMutable) + { + fprintf(stderr, ERR("global %s not mutable"), name_c); + return u3m_bail(c3__fail); + } + + M3TaggedValue glob_value; + M3Result result = m3_GetGlobal(glob, &glob_value); + if (result) + { + fprintf(stderr, ERR("couldn't get global %s: %s"), name_c, result); + return u3m_bail(c3__fail); + } + switch (glob_value.type) + { + default: + { + return u3m_bail(c3__fail); + } + case c_m3Type_i32: + { + glob_value.value.i32 = u3r_word(0, value); + break; + } + case c_m3Type_i64: + { + glob_value.value.i64 = u3r_chub(0, value); + break; + } + case c_m3Type_f32: + { + glob_value.value.f32 = u3r_word(0, value); + break; + } + case c_m3Type_f64: + { + glob_value.value.f64 = u3r_chub(0, value); + break; + } + } + result = m3_SetGlobal(glob, &glob_value); + if (result) + { + fprintf(stderr, ERR("couldn't set global %s: %s"), name_c, result); + return u3m_bail(c3__fail); + } + u3z(monad); + u3a_free(name_c); + return u3nc(0, 0); + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->global_get_bat)) + { + if (c3n == u3r_sing(u3at(ARROW_CTX, monad), sat_u->match->global_get_ctx)) + { + return u3m_bail(c3__fail); + } + // global-get + u3_atom name = u3x_atom(u3at(arr_sam, monad)); + + c3_w met_w = u3r_met(3, name); + c3_c* name_c = u3a_malloc(met_w + 1); + u3r_bytes(0, met_w, (c3_y*)name_c, name); + name_c[met_w] = 0; + + IM3Global glob = m3_FindGlobal(sat_u->wasm_module, name_c); + if (!glob) + { + fprintf(stderr, ERR("global %s not found"), name_c); + return u3m_bail(c3__fail); + } + + M3TaggedValue glob_value; + M3Result result = m3_GetGlobal(glob, &glob_value); + if (result) + { + fprintf(stderr, ERR("couldn't get global %s: %s"), name_c, result); + return u3m_bail(c3__fail); + } + + u3_noun out; + switch (glob_value.type) + { + default: + { + return u3m_bail(c3__fail); + } + case c_m3Type_i32: + { + out = u3i_word(glob_value.value.i32); + break; + } + case c_m3Type_i64: + { + out = u3i_chub(glob_value.value.i64); + break; + } + case c_m3Type_f32: + { + out = u3i_word(glob_value.value.f32); + break; + } + case c_m3Type_f64: + { + out = u3i_chub(glob_value.value.f64); + break; + } + } + + u3z(monad); + u3a_free(name_c); + return u3nc(0, out); + + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->mem_size_bat)) + { + if (c3n == u3r_sing(u3at(MONAD_CTX, monad), sat_u->match->mem_size_ctx)) + { + return u3m_bail(c3__fail); + } + // memory-size + if (!sat_u->wasm_module->memoryInfo.hasMemory) + { + fprintf(stderr, ERR("memsize no memory")); + return u3m_bail(c3__fail); + } + c3_w num_pages = sat_u->wasm_module->runtime->memory.numPages; + + u3z(monad); + return u3nc(0, u3i_word(num_pages)); + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->mem_grow_bat)) + { + if (c3n == u3r_sing(u3at(ARROW_CTX, monad), sat_u->match->mem_grow_ctx)) + { + return u3m_bail(c3__fail); + } + // memory-grow + if (!sat_u->wasm_module->memoryInfo.hasMemory) + { + fprintf(stderr, ERR("memgrow no memory")); + return u3m_bail(c3__fail); + } + + u3_noun delta = u3at(arr_sam, monad); + + c3_l delta_l = (c3y == u3a_is_cat(delta)) ? delta : u3m_bail(c3__fail); + + c3_w n_pages = sat_u->wasm_module->runtime->memory.numPages; + c3_w required_pages = n_pages + delta_l; + + M3Result result = ResizeMemory(sat_u->wasm_module->runtime, required_pages); + + if (result) + { + fprintf(stderr, ERR("failed to resize memory: %s"), result); + return u3m_bail(c3__fail); + } + + u3z(monad); + return u3nc(0, u3i_word(n_pages)); + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->get_acc_bat)) + { + u3z(monad); + return u3nc(0, u3k(sat_u->acc)); + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->set_acc_bat)) + { + u3_noun new = u3k(u3at(arr_sam, monad)); + u3z(monad); + u3z(sat_u->acc); + sat_u->acc = new; + return u3nc(0, 0); + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->get_all_glob_bat)) + { + if (c3n == u3r_sing(u3at(MONAD_CTX, monad), sat_u->match->get_all_glob_ctx)) + { + return u3m_bail(c3__fail); + } + u3z(monad); + u3_noun atoms = u3_nul; + c3_w n_globals = sat_u->wasm_module->numGlobals; + c3_w n_globals_import = sat_u->wasm_module->numGlobImports; + while (n_globals-- > n_globals_import) + { + M3Global glob = sat_u->wasm_module->globals[n_globals]; + switch (glob.type) + { + default: + { + return u3m_bail(c3__fail); + } + case c_m3Type_i32: + { + atoms = u3nc(u3i_word(glob.intValue), atoms); + break; + } + case c_m3Type_i64: + { + atoms = u3nc(u3i_chub(glob.intValue), atoms); + break; + } + case c_m3Type_f32: + { + atoms = u3nc(u3i_word(glob.f32Value), atoms); + break; + } + case c_m3Type_f64: + { + atoms = u3nc(u3i_chub(glob.f64Value), atoms); + break; + } + } + } + return u3nc(0, atoms); + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->set_all_glob_bat)) + { + if (c3n == u3r_sing(u3at(ARROW_CTX, monad), sat_u->match->set_all_glob_ctx)) + { + return u3m_bail(c3__fail); + } + u3_noun atoms = u3at(arr_sam, monad); + c3_w n_globals = sat_u->wasm_module->numGlobals; + c3_w n_globals_import = sat_u->wasm_module->numGlobImports; + for (c3_w i = n_globals_import; i < n_globals; i++) + { + IM3Global glob = &sat_u->wasm_module->globals[i]; + u3_noun atom; + u3x_cell(atoms, &atom, &atoms); + u3x_atom(atom); + switch (glob->type) + { + default: + { + return u3m_bail(c3__fail); + } + case c_m3Type_i32: + { + glob->intValue = u3r_word(0, atom); + break; + } + case c_m3Type_i64: + { + glob->intValue = u3r_chub(0, atom); + break; + } + case c_m3Type_f32: + { + glob->f32Value = u3r_word(0, atom); + break; + } + case c_m3Type_f64: + { + glob->f64Value = u3r_chub(0, atom); + break; + } + } + } + if (u3_nul != atoms) + { + fprintf(stderr, WUT("glob list too long")); + return u3m_bail(c3__exit); + } + u3z(monad); + return u3nc(0, 0); + } + else if (c3y == u3r_sing(monad_bat, sat_u->match->fail_bat)) + { + u3z(monad); + return u3nc(2, 0); + } + else + { + return u3m_bail(c3__fail); + } +} + +static const M3Result +_resume_callback(M3Result result_m3, IM3Runtime runtime) +{ + if (result_m3 == m3Err_ComputationBlock + || result_m3 == m3Err_SuspensionError) + { + return result_m3; + } + M3Result result = m3Err_none; + lia_state* sat_u = runtime->userdata_resume; + m3_SuspendStackPopExtTag(runtime); + c3_d tag_d; + m3_SuspendStackPop64(runtime, &tag_d); + switch (tag_d) + { + default: + { + u3m_bail(c3__fail); + } + case west_call: + { + c3_d f_idx_d; + m3_SuspendStackPop64(sat_u->wasm_module->runtime, &f_idx_d); + u3_noun frame = _pop_list(&sat_u->susp_list); + if (lst_call != u3h(frame)) + { + printf(ERR("wrong frame: call")); + u3m_bail(c3__fail); + } + u3_noun name = u3t(frame); + c3_w met_w = u3r_met(3, name); + c3_c* name_c = u3a_malloc(met_w + 1); + u3r_bytes(0, met_w, (c3_y*)name_c, name); + u3z(frame); + name_c[met_w] = 0; + + u3_noun yil; + if (_deterministic_trap(result_m3)) + { + fprintf(stderr, WUT("%s call trapped: %s"), name_c, result_m3); + yil = u3nc(2, 0); + } + else if (result_m3) + { + fprintf(stderr, ERR("%s call failed: %s"), name_c, result_m3); + u3m_bail(c3__fail); + } + else + { + IM3Function f = runtime->modules->functions + f_idx_d; + c3_w n_out_w = f->funcType->numRets; + c3_d *vals_out = u3a_calloc(n_out_w, sizeof(c3_d)); + void **valptrs_out = u3a_calloc(n_out_w, sizeof(void*)); + for (c3_w i = 0; i < n_out_w; i++) + { + valptrs_out[i] = &vals_out[i]; + } + M3Result result_tmp = m3_GetResults(f, + n_out_w, + (const void**)valptrs_out + ); + if (result_tmp) + { + fprintf(stderr, + ERR("function %s failed to get results: %s"), name_c, result_tmp + ); + u3m_bail(c3__fail); + } + yil = u3nc(0, + _atoms_from_stack(valptrs_out, n_out_w, f->funcType->types) + ); + u3a_free(valptrs_out); + u3a_free(vals_out); + } + if (u3_none != sat_u->resolution) + { + u3m_bail(c3__fail); + } + sat_u->resolution = yil; + u3a_free(name_c); + break; + } + + case west_call_ext: + { + if (1 == u3h(sat_u->resolution)) + { + // it's a new block, it's not yet resolved + // restore the frame + // + m3_SuspendStackPush64(runtime, tag_d); + m3_SuspendStackPushExtTag(runtime); + result = m3Err_ComputationBlock; + } + // else the block is resolved and sat_u->resolution holds the result + // + break; + } + + case west_try: + { + if (1 != u3h(sat_u->resolution)) + { + u3_noun frame = _pop_list(&sat_u->susp_list); + if (lst_try != u3h(frame)) + { + printf(ERR("wrong frame: try")); + u3m_bail(c3__fail); + } + if (0 == u3h(sat_u->resolution)) + { + u3_noun cont = u3t(frame); + u3_noun p_res = u3t(sat_u->resolution); + uw_arena* box_arena_frame = BoxArena; + uw_arena* code_arena_frame = CodeArena; + u3_noun monad_cont = uw_slam_check( + u3k(cont), + u3k(p_res), + sat_u->is_stateful + ); + BoxArena = box_arena_frame; + CodeArena = code_arena_frame; + u3z(sat_u->resolution); + sat_u->resolution = _reduce_monad(monad_cont, sat_u); + } + // if %2 then nothing to do, sat_u->resolution already holds %2 result + // + u3z(frame); + } + else + { + // we shouldn't be here + // + u3m_bail(c3__fail); + } + break; + } + + case west_catch_try: + { + if (1 != u3h(sat_u->resolution)) + { + u3_noun frame = _pop_list(&sat_u->susp_list); + if (lst_catch_try != u3h(frame)) + { + printf(ERR("wrong frame: catch-try")); + u3m_bail(c3__fail); + } + if (0 == u3h(sat_u->resolution)) + { + u3_noun cont = u3t(u3t(frame)); + u3_noun p_res = u3t(sat_u->resolution); + uw_arena* box_arena_frame = BoxArena; + uw_arena* code_arena_frame = CodeArena; + u3_noun monad_cont = uw_slam_check( + u3k(cont), + u3k(p_res), + sat_u->is_stateful + ); + BoxArena = box_arena_frame; + CodeArena = code_arena_frame; + u3z(sat_u->resolution); + sat_u->resolution = _reduce_monad(monad_cont, sat_u); + } + // %2 + // + else + { + u3_noun cont = u3t(u3t(frame)); + u3_noun monad_catch = u3h(u3t(frame)); + { // push on suspend stacks + m3_SuspendStackPush64(sat_u->wasm_module->runtime, west_catch_err); + m3_SuspendStackPushExtTag(runtime); + _push_list( + u3nc(lst_catch_err, u3k(cont)), + &sat_u->susp_list + ); + } + + u3_noun yil = _reduce_monad(u3k(monad_catch), sat_u); + + if (1 != u3h(yil)) + { // pop suspend stacks + m3_SuspendStackPopExtTag(runtime); + c3_d tag; + m3_SuspendStackPop64(sat_u->wasm_module->runtime, &tag); + if (tag != -1 && tag != west_catch_err) + { + printf(ERR("catch-err tag mismatch: %"PRIc3_d), tag); + u3m_bail(c3__fail); + } + u3_noun frame1 = _pop_list(&sat_u->susp_list); + if (lst_catch_err != u3h(frame1)) + { + printf(ERR("wrong frame: catch-err")); + u3m_bail(c3__fail); + } + u3z(frame1); + } + + if (2 == u3h(yil)) + { + // sat_u->resolution already has %2, do nothing + u3z(yil); + } + else if (1 == u3h(yil)) + { + u3z(sat_u->resolution); + sat_u->resolution = yil; + } + else // %0 + { + u3_noun p_res = u3t(yil); + uw_arena* box_arena_frame = BoxArena; + uw_arena* code_arena_frame = CodeArena; + u3_noun monad_cont = uw_slam_check( + u3k(cont), + u3k(p_res), + sat_u->is_stateful + ); + BoxArena = box_arena_frame; + CodeArena = code_arena_frame; + u3z(sat_u->resolution); + u3z(yil); + sat_u->resolution = _reduce_monad(monad_cont, sat_u); + } + } + u3z(frame); + } + else + { + // we shouldn't be here + // + u3m_bail(c3__fail); + } + break; + } + case west_catch_err: + { + if (1 != u3h(sat_u->resolution)) + { + u3_noun frame = _pop_list(&sat_u->susp_list); + if (lst_catch_err != u3h(frame)) + { + printf(ERR("wrong frame: catch-err")); + u3m_bail(c3__fail); + } + if (0 == u3h(sat_u->resolution)) + { + u3_noun cont = u3t(frame); + u3_noun p_res = u3t(sat_u->resolution); + uw_arena* box_arena_frame = BoxArena; + uw_arena* code_arena_frame = CodeArena; + u3_noun monad_cont = uw_slam_check( + u3k(cont), + u3k(p_res), + sat_u->is_stateful + ); + BoxArena = box_arena_frame; + CodeArena = code_arena_frame; + u3z(sat_u->resolution); + sat_u->resolution = _reduce_monad(monad_cont, sat_u); + } + // if %2 then nothing to do, sat_u->resolution already holds %2 result + // + u3z(frame); + } + else + { + // we shouldn't be here + // + u3m_bail(c3__fail); + } + break; + } + case west_link_wasm: + { + if (1 != u3h(sat_u->resolution)) + { + c3_d _sp_offset_d, func_idx_d; + m3_SuspendStackPop64(runtime, &func_idx_d); + m3_SuspendStackPop64(runtime, &_sp_offset_d); + if (2 == u3h(sat_u->resolution)) + { + u3z(sat_u->resolution); + sat_u->resolution = u3_none; + result = UrwasmArrowExit; + } + else // %0 + { + IM3Function f = runtime->modules->functions + func_idx_d; + uint64_t * _sp = (uint64_t *)(runtime->base + _sp_offset_d); + c3_w n_out = f->funcType->numRets; + c3_y* types = f->funcType->types; + void **valptrs_out = u3a_calloc(n_out, sizeof(void*)); + const char *mod = f->import.moduleUtf8; + const char *name = f->import.fieldUtf8; + for (c3_w i = 0; i < n_out; i++) + { + valptrs_out[i] = &_sp[i]; + } + c3_o pushed = _coins_to_stack( + u3t(sat_u->resolution), + valptrs_out, + n_out, + types + ); + + if (c3n == pushed) + { + printf(ERR("import result type mismatch: %s/%s"), mod, name); + result = "import result type mismatch"; + } + + u3z(sat_u->resolution); + sat_u->resolution = u3_none; + u3a_free(valptrs_out); + } + } + else + { + // we shouldn't be here + // + u3m_bail(c3__fail); + } + break; + } + } + + return result; +} + +// TRANSFERS sat->arrow_yil if m3Err_ComputationBlock is thrown +static const void * +_link_wasm_with_arrow_map( + IM3Runtime runtime, + IM3ImportContext _ctx, + uint64_t * _sp, + void * _mem +) +{ + const char *mod = _ctx->function->import.moduleUtf8; + const char *name = _ctx->function->import.fieldUtf8; + lia_state* sat_u = _ctx->userdata; + + u3_noun key = u3nc(u3i_string(mod), u3i_string(name)); + u3_weak arrow = u3kdb_get(u3k(sat_u->map), key); + if (u3_none == arrow) + { + fprintf(stderr, ERR("import not found: %s/%s"), mod, name); + return m3Err_functionImportMissing; + } + c3_w n_in = _ctx->function->funcType->numArgs; + c3_w n_out = _ctx->function->funcType->numRets; + c3_y* types = _ctx->function->funcType->types; + void **valptrs_in = u3a_calloc(n_in, sizeof(void*)); + for (c3_w i = 0; i < n_in; i++) + { + valptrs_in[i] = &_sp[i+n_out]; + } + void **valptrs_out = u3a_calloc(n_out, sizeof(void*)); + for (c3_w i = 0; i < n_out; i++) + { + valptrs_out[i] = &_sp[i]; + } + + u3_noun coin_wasm_list = _coins_from_stack(valptrs_in, n_in, (types+n_out)); + + { // push on suspend stacks + m3_SuspendStackPush64(runtime, (c3_d)((c3_y*)_sp - (c3_y*)runtime->base)); + c3_d func_idx_d = _ctx->function - runtime->modules->functions; + m3_SuspendStackPush64(runtime, func_idx_d); + m3_SuspendStackPush64(runtime, west_link_wasm); + m3_SuspendStackPushExtTag(runtime); + } + + uw_arena* box_arena_frame = BoxArena; + uw_arena* code_arena_frame = CodeArena; + u3_noun script = uw_slam_check(arrow, coin_wasm_list, sat_u->is_stateful); + BoxArena = box_arena_frame; + CodeArena = code_arena_frame; + u3_noun yil = _reduce_monad(script, sat_u); + + M3Result result = m3Err_none; + + if (1 != u3h(yil)) + { // pop suspend stacks + m3_SuspendStackPopExtTag(runtime); + c3_d tag; + m3_SuspendStackPop64(runtime, &tag); + if (tag != -1 && tag != west_link_wasm) + { + printf(ERR("west_link tag mismatch: %"PRIc3_d), tag); + u3m_bail(c3__fail); + } + m3_SuspendStackPop64(runtime, NULL); + m3_SuspendStackPop64(runtime, NULL); + + } + + if (1 == u3h(yil)) + { + if (sat_u->arrow_yil != u3_none) + { + u3z(yil); + result = "non-empty sat_u->arrow_yil on block"; + } + else + { + sat_u->arrow_yil = yil; + result = m3Err_ComputationBlock; // start suspending if not yet suspending + } + } + else if (2 == u3h(yil)) + { + u3z(yil); + result = UrwasmArrowExit; + } + else + { + c3_o pushed = _coins_to_stack(u3t(yil), valptrs_out, n_out, types); + u3z(yil); + if (c3n == pushed) + { + fprintf(stderr, ERR("import result type mismatch: %s/%s"), mod, name); + result = "import result type mismatch"; + } + } + u3a_free(valptrs_in); + u3a_free(valptrs_out); + return result; +} + +// key: [uw_run_m seed] +// stored nouns: +// $@ ~ :: tombstone value +// $: yield=* :: +2 +// queue=(list script) :: +6 +// box_arena=[buffer=octs padding=@] :: [[+56 +57] +29] +// memory=[buffer=octs max_stack_offset=@] :: [[+120 +121] +61] +// runtime_offset=@ :: +62 +// lia_shop=(list) :: +126 +// acc=* :: +254 +// susp_list=(list) :: +255 +// == +// arguments RETAINED +// on success allocates sat_u->wasm_module->runtime->memory.mallocated +// and initializes the arenas +static c3_t +_get_state(u3_noun hint, u3_noun seed, lia_state* sat_u) +{ + // u3_weak get = u3z_find_m(u3z_memo_keep, uw_run_m, seed); + // XX order of search matters (sentinel value ~ + // from previous invocation is closer to the home road) + // and u3z_find_m searches from home road down, which is the opposite + // of what we want + // + u3_noun key = u3z_key(uw_run_m, seed); + u3_weak get = u3z_find_up(key); + u3z(key); + + if (u3_none == get || u3_nul == get) + { + return 0; + } + else + { + u3_noun yil_previous; + u3_noun queue; + u3_noun p_box_buffer, q_box_buffer, pad_box; + u3_noun p_mem_buffer, q_mem_buffer, stack_offset; + u3_noun runtime_offset; + u3_noun lia_shop; + u3_noun acc; + u3_noun susp_list; + + if ( c3n == u3r_mean(get, + 2, &yil_previous, + 6, &queue, + 56, &p_box_buffer, + 57, &q_box_buffer, + 29, &pad_box, + 120, &p_mem_buffer, + 121, &q_mem_buffer, + 61, &stack_offset, + 62, &runtime_offset, + 126, &lia_shop, + 254, &acc, + 255, &susp_list, + 0) + ) + { + return u3m_bail(c3__fail); + } + c3_w box_len_w = (c3y == u3a_is_cat(p_box_buffer)) + ? p_box_buffer + : u3m_bail(c3__fail); + + c3_w pad_w = (c3y == u3a_is_cat(pad_box)) + ? pad_box + : u3m_bail(c3__fail); + + c3_w run_off_w = (c3y == u3a_is_cat(runtime_offset)) + ? runtime_offset + : u3m_bail(c3__fail); + + c3_w len_buf_w = (c3y == u3a_is_cat(p_mem_buffer)) + ? p_mem_buffer + : u3m_bail(c3__fail); + + c3_w stk_off_w = (c3y == u3a_is_cat(stack_offset)) + ? stack_offset + : u3m_bail(c3__fail); + + _uw_arena_init_size(BoxArena, box_len_w); + u3r_bytes(pad_w, box_len_w, BoxArena->buf_y, q_box_buffer); + _uw_arena_init(CodeArena); + + M3Result result; + IM3Runtime wasm3_runtime = (IM3Runtime)(BoxArena->buf_y + run_off_w); + wasm3_runtime->base = BoxArena->buf_y; + wasm3_runtime->base_transient = CodeArena->buf_y; + m3_RewritePointersRuntime(wasm3_runtime, BoxArena->buf_y, 0 /*is_store*/); + IM3Module wasm3_module = wasm3_runtime->modules; + c3_w n_imports = wasm3_module->numFuncImports; + + // make sure to not touch BoxArena + m3_SetAllocators(_calloc_bail, _free_bail, _realloc_bail); + m3_SetTransientAllocators(_calloc_code, _free_code, _realloc_code); + m3_SetMemoryAllocators(_calloc_bail, _free_bail, _realloc_bail); + + jmp_buf esc; + CodeArena->esc_u = &esc; + c3_i jmp_i; + + while (1) + { + wasm3_runtime->base_transient = CodeArena->buf_y; + + if (0 == (jmp_i = setjmp(esc))) + { + for (c3_w i = 0; i < n_imports; i++) + { + M3Function f = wasm3_module->functions[i]; + const char* mod = f.import.moduleUtf8; + const char* name = f.import.fieldUtf8; + + result = m3_LinkRawFunctionEx( + wasm3_module, mod, name, + NULL, &_link_wasm_with_arrow_map, + sat_u + ); + + if (result) + { + fprintf(stderr, ERR("link error: %s"), result); + return u3m_bail(c3__fail); + } + } + + result = m3_CompileModule(wasm3_module); + if (result) + { + fprintf(stderr, ERR("compilation error: %s"), result); + return u3m_bail(c3__fail); + } + + break; + } + else + { + if (jmp_i == c3__code) + { + _uw_arena_grow(CodeArena); + } + else + { + return u3m_bail(c3__fail); + } + continue; + } + } + + { + sat_u->yil_previous = u3k(yil_previous); + sat_u->queue = u3k(queue); + sat_u->wasm_module = wasm3_module; + sat_u->lia_shop = u3k(lia_shop); + sat_u->acc = u3k(acc); + // sat_u->map to be filled afterwards + // sat_u->match same + // sat_u->resolution same + sat_u->arrow_yil = u3_none; + sat_u->susp_list = u3k(susp_list); + M3MemoryHeader* mem = u3a_malloc(len_buf_w + sizeof(M3MemoryHeader)); + mem->runtime = wasm3_runtime; + mem->maxStack = BoxArena->buf_y + stk_off_w; + mem->length = len_buf_w; + u3r_bytes(0, len_buf_w, (u8*)(mem + 1), q_mem_buffer); + wasm3_runtime->memory.mallocated = mem; + } + + u3z(get); + + return 1; + } +} + +// arguments RETAINED, returned yield transfered. +// transfers sat_u->yil_previous if it is returned, and replaces +// the struct value with u3_none +static u3_noun +_apply_diff(u3_noun input_tag, u3_noun p_input, lia_state* sat_u) +{ + m3_SetAllocators(_calloc_bail, _free_bail, _realloc_bail); + m3_SetTransientAllocators(_calloc_bail, _free_bail, _realloc_bail); + m3_SetMemoryAllocators(u3a_calloc, u3a_free, u3a_realloc); + + if (input_tag == c3y) + { + if (sat_u->wasm_module->runtime->edge_suspend) + { + // appended new script but the computation is still suspended: + // add script to queue, return previous yield + if (sat_u->yil_previous == u3_none) + { + return u3m_bail(c3__fail); + } + sat_u->queue = u3kb_weld(sat_u->queue, u3nc(u3k(p_input), u3_nul)); // snoc + u3_noun yil = sat_u->yil_previous; + sat_u->yil_previous = u3_none; + return yil; + } + else + { + return _reduce_monad(u3k(p_input), sat_u); + } + } + else + { + if (!sat_u->wasm_module->runtime->edge_suspend) + { + // appended external call resolution but no block to resolve: + // snoc result to shop, return previous yield + if (sat_u->yil_previous == u3_none) + { + return u3m_bail(c3__fail); + } + sat_u->lia_shop = u3kb_weld(sat_u->lia_shop, u3nc(u3k(p_input), u3_nul)); // snoc + u3_noun yil = sat_u->yil_previous; + sat_u->yil_previous = u3_none; + return yil; + } + // else resume + IM3Runtime run_u = sat_u->wasm_module->runtime; + run_u->resume_external = _resume_callback; + run_u->userdata_resume = sat_u; + if (sat_u->resolution != u3_none) + { + return u3m_bail(c3__fail); + } + sat_u->resolution = u3nc(0, u3k(p_input)); + M3Result result = m3_Resume(run_u); + u3_noun yil; + if (result == m3Err_ComputationBlock) + { + yil = sat_u->resolution; + sat_u->resolution = u3_none; + if (yil == u3_none) + { + yil = sat_u->arrow_yil; + sat_u->arrow_yil = u3_none; + if (yil == u3_none) + { + return u3m_bail(c3__fail); + } + } + } + else if (_deterministic_trap(result)) + { + fprintf(stderr, WUT("function call trapped: %s"), result); // XX get name of entry function? + yil = u3nc(2, 0); + } + else if (result == m3Err_functionImportMissing) + { + return u3m_bail(c3__exit); + } + else if (result) + { + fprintf(stderr, ERR("resumption failed: %s"), result); + return u3m_bail(c3__fail); + } + else + { + yil = sat_u->resolution; + sat_u->resolution = u3_none; + if (yil == u3_none) + { + return u3m_bail(c3__fail); + } + + if (sat_u->queue != u3_none) + { + while (u3h(yil) == 0 && sat_u->queue != u3_nul) + { + u3z(yil); + u3_noun deferred_script = _pop_list(&sat_u->queue); + yil = _reduce_monad(deferred_script, sat_u); + } + } + } + + return yil; + } +} + +// try to save new state, replacing old state with a tombstone value +// frees wasm3 memory buffer, releases arenas +// RETAINS arguments, transfers sat_u->lia_shop/susp_list/queue and +// replaces them with u3_none if save is succesful +static void +_move_state( + lia_state* sat_u, + u3_noun seed_old, + u3_noun seed_new, + u3_noun hint, + u3_noun yil) +{ + if ( (c3__oust == hint) + || (2 == u3h(yil)) + || (c3__rand == hint && 0 == u3h(yil)) + ) + { + u3z_save_m(u3z_memo_keep, uw_run_m, seed_old, u3_nul); + IM3Runtime run_u = sat_u->wasm_module->runtime; + M3MemoryHeader* mem_u = run_u->memory.mallocated; + u3a_free(mem_u); + _uw_arena_free(CodeArena); + _uw_arena_free(BoxArena); + return; + } + + IM3Runtime run_u = sat_u->wasm_module->runtime; + M3MemoryHeader* mem_u = run_u->memory.mallocated; + c3_w stk_off_w = (u8*)mem_u->maxStack - BoxArena->buf_y; + if (c3n == u3a_is_cat(stk_off_w)) + { + u3m_bail(c3__fail); + } + + c3_w len_buf_w = mem_u->length; + if (c3n == u3a_is_cat(len_buf_w)) + { + u3m_bail(c3__fail); + } + + u3_atom q_buf = u3i_bytes(len_buf_w, (c3_y*)(mem_u + 1)); + + u3a_free(mem_u); + + m3_RewritePointersRuntime(run_u, BoxArena->buf_y, 1 /*is_store*/); + c3_w run_off_w = (c3_y*)run_u - BoxArena->buf_y; + if (c3n == u3a_is_cat(run_off_w)) + { + u3m_bail(c3__fail); + } + + _uw_arena_free(CodeArena); + + c3_w box_len_w = BoxArena->siz_w; + if (c3n == u3a_is_cat(box_len_w)) + { + u3m_bail(c3__fail); + } + + c3_y pad_y = BoxArena->pad_y; + + u3_atom q_box = u3i_slab_mint(&BoxArena->sab_u); + BoxArena->ini_t = 0; + + u3_noun stash = uw_octo( + u3k(yil), + sat_u->queue, + u3nc(u3nc(box_len_w, q_box), pad_y), + u3nc(u3nc(len_buf_w, q_buf), stk_off_w), + run_off_w, + sat_u->lia_shop, + u3k(sat_u->acc), // accumulator will be returned + sat_u->susp_list + ); + sat_u->lia_shop = u3_none; + sat_u->susp_list = u3_none; + sat_u->queue = u3_none; + + u3z_save_m(u3z_memo_keep, uw_run_m, seed_old, u3_nul); + + u3z_save_m(u3z_memo_keep, uw_run_m, seed_new, stash); + + u3z(stash); +} + +u3_weak +u3we_lia_run_v1(u3_noun cor) +{ +#ifndef URWASM_STATEFUL + return u3_none; +#else + + u3_noun hint = u3at(u3x_sam_7, cor); + if (c3__none == hint) + { + return u3_none; + } + + // strand: save %1, delete in other cases + c3_t rand_t = (c3__rand == hint); + + // agent: always save + c3_t gent_t = (c3__gent == hint); + + // oust: don't save + c3_t oust_t = (c3__oust == hint); + + // omit: run statelessly + c3_t omit_t = !(rand_t || gent_t || oust_t); + + #ifdef URWASM_SUBROAD + + // enter subroad, 4MB safety buffer + u3m_hate(1 << 20); + + #endif + + u3_noun ctx = u3at(RUN_CTX, cor); + u3r_mug(ctx); + + u3_noun input = u3at(u3x_sam_2, cor); + u3_noun seed = u3at(u3x_sam_6, cor); + + u3_noun runnable = uw_kick_nock(u3k(ctx), AX_RUNNABLE); + u3_noun arrows = KICK1(uw_kick_nock(u3k(ctx), AX_ARROWS)); + + u3_noun try_gate = uw_kick_nock(u3k(runnable), AX_TRY); + u3_noun try_gate_inner = KICK1(try_gate); + + u3_noun seed_new; + u3_noun input_tag, p_input; + u3x_cell(input, &input_tag, &p_input); + + if (input_tag == c3y) + { + u3_noun p_input_gate = u3nt(u3nc(0, 7), 0, u3k(p_input)); // =>(p.input |=(* +>)) + u3_noun past_new = uw_slam_nock( + u3k(try_gate_inner), + u3nc( + u3k(u3at(seed_past, seed)), + p_input_gate + ) + ); + seed_new = u3nq( + u3k(u3at(seed_module, seed)), + past_new, + u3k(u3at(seed_shop, seed)), + u3k(u3at(seed_import, seed)) + ); + } + else if (input_tag == c3n) + { + seed_new = u3nq( + u3k(u3at(seed_module, seed)), + u3k(u3at(seed_past, seed)), + u3nc(u3k(p_input), u3k(u3at(seed_shop, seed))), + u3k(u3at(seed_import, seed)) + ); + } + else + { + return u3m_bail(c3__fail); + } + + u3_noun call_script = KICK1(uw_kick_nock(u3k(arrows), AX_CALL)); + u3_noun memread_script = KICK1(uw_kick_nock(u3k(arrows), AX_MEMREAD)); + u3_noun memwrite_script = KICK1(uw_kick_nock(u3k(arrows), AX_MEMWRITE)); + u3_noun call_ext_script = KICK1(uw_kick_nock(u3k(arrows), AX_CALL_EXT)); + u3_noun global_set_script = KICK1(uw_kick_nock(u3k(arrows), AX_GLOBAL_SET)); + u3_noun global_get_script = KICK1(uw_kick_nock(u3k(arrows), AX_GLOBAL_GET)); + u3_noun mem_grow_script = KICK1(uw_kick_nock(u3k(arrows), AX_MEM_GROW)); + u3_noun mem_size_script = uw_kick_nock(u3k(arrows), AX_MEM_SIZE); + u3_noun get_acc_script = uw_kick_nock(u3k(arrows), AX_GET_ACC); + u3_noun set_acc_script = KICK1(uw_kick_nock(u3k(arrows), AX_SET_ACC)); + u3_noun get_all_glob_script = uw_kick_nock(u3k(arrows), AX_GET_ALL_GLOB); + u3_noun set_all_glob_script = KICK1(uw_kick_nock( arrows, AX_SET_ALL_GLOB)); + + u3_noun try_script = KICK1(try_gate_inner); + u3_noun catch_script = KICK2(uw_kick_nock(u3k(runnable), AX_CATCH)); + u3_noun return_script = KICK1(uw_kick_nock(u3k(runnable), AX_RETURN)); + u3_noun fail_script = uw_kick_nock( runnable, AX_FAIL); + + u3_noun call_bat = u3k(u3h(call_script)); + u3_noun memread_bat = u3k(u3h(memread_script)); + u3_noun memwrite_bat = u3k(u3h(memwrite_script)); + u3_noun call_ext_bat = u3k(u3h(call_ext_script)); + u3_noun try_bat = u3k(u3h(try_script)); + u3_noun catch_bat = u3k(u3h(catch_script)); + u3_noun return_bat = u3k(u3h(return_script)); + u3_noun fail_bat = u3k(u3h(fail_script)); + u3_noun global_set_bat = u3k(u3h(global_set_script)); + u3_noun global_get_bat = u3k(u3h(global_get_script)); + u3_noun mem_grow_bat = u3k(u3h(mem_grow_script)); + u3_noun mem_size_bat = u3k(u3h(mem_size_script)); + u3_noun get_acc_bat = u3k(u3h(get_acc_script)); + u3_noun set_acc_bat = u3k(u3h(set_acc_script)); + u3_noun get_all_glob_bat = u3k(u3h(get_all_glob_script)); + u3_noun set_all_glob_bat = u3k(u3h(set_all_glob_script)); + + u3_noun call_ctx = u3k(u3at(ARROW_CTX, call_script)); + u3_noun memread_ctx = u3k(u3at(ARROW_CTX, memread_script)); + u3_noun memwrite_ctx = u3k(u3at(ARROW_CTX, memwrite_script)); + u3_noun global_set_ctx = u3k(u3at(ARROW_CTX, global_set_script)); + u3_noun global_get_ctx = u3k(u3at(ARROW_CTX, global_get_script)); + u3_noun mem_grow_ctx = u3k(u3at(ARROW_CTX, mem_grow_script)); + u3_noun mem_size_ctx = u3k(u3at(MONAD_CTX, mem_size_script)); + u3_noun get_all_glob_ctx = u3k(u3at(MONAD_CTX, get_all_glob_script)); + u3_noun set_all_glob_ctx = u3k(u3at(ARROW_CTX, set_all_glob_script)); + + u3z(call_script); + u3z(memread_script); + u3z(memwrite_script); + u3z(call_ext_script); + u3z(try_script); + u3z(catch_script); + u3z(return_script); + u3z(fail_script); + u3z(global_set_script); + u3z(global_get_script); + u3z(mem_grow_script); + u3z(mem_size_script); + u3z(get_acc_script); + u3z(set_acc_script); + u3z(get_all_glob_script); + u3z(set_all_glob_script); + + match_data_struct match = { + call_bat, + memread_bat, + memwrite_bat, + call_ext_bat, + try_bat, + catch_bat, + return_bat, + fail_bat, + global_set_bat, + global_get_bat, + mem_grow_bat, + mem_size_bat, + get_acc_bat, + set_acc_bat, + get_all_glob_bat, + set_all_glob_bat, + // + call_ctx, + memread_ctx, + memwrite_ctx, + global_set_ctx, + global_get_ctx, + mem_grow_ctx, + mem_size_ctx, + get_all_glob_ctx, + set_all_glob_ctx, + }; + + lia_state sat; + + BoxArena = &sat.box_arena; + CodeArena = &sat.code_arena; + + u3_noun yil; + if (!omit_t) + { + sat.is_stateful = 1; + if (_get_state(hint, seed, &sat)) + { + sat.map = u3t(u3at(seed_import, seed)); + sat.match = &match; + sat.resolution = u3_none; + yil = _apply_diff(input_tag, p_input, &sat); + } + else + { // instantiate state with retries + u3_noun octs = u3at(seed_module, seed_new); + u3_noun p_octs, q_octs; + u3x_cell(octs, &p_octs, &q_octs); + c3_w bin_len_w = (c3y == u3a_is_cat(p_octs)) ? p_octs + : u3m_bail(c3__fail); + c3_y* bin_y; + M3Result result; + IM3Environment wasm3_env; + IM3Runtime wasm3_runtime = NULL; + IM3Module wasm3_module; + + _uw_arena_init(CodeArena); + _uw_arena_init(BoxArena); + + m3_SetAllocators(_calloc_box, _free_box, _realloc_box); + m3_SetTransientAllocators(_calloc_code, _free_code, _realloc_code); + m3_SetMemoryAllocators(u3a_calloc, u3a_free, u3a_realloc); + jmp_buf esc; + CodeArena->esc_u = BoxArena->esc_u = &esc; + c3_i jmp_i; + + while (1) + { + if (0 == (jmp_i = setjmp(esc))) + { + bin_y = _calloc_box(bin_len_w, 1); + u3r_bytes(0, bin_len_w, bin_y, u3x_atom(q_octs)); + + wasm3_env = m3_NewEnvironment(); + if (!wasm3_env) + { + fprintf(stderr, ERR("env is null")); + return u3m_bail(c3__fail); + } + + wasm3_runtime = m3_NewRuntime( + wasm3_env, + 1 << 21, + NULL, + 1 /* suspend */ + ); + if (!wasm3_runtime) + { + fprintf(stderr, ERR("runtime is null")); + return u3m_bail(c3__fail); + } + + result = m3_ParseModule(wasm3_env, &wasm3_module, bin_y, bin_len_w); + if (result) + { + fprintf(stderr, ERR("parse binary error: %s"), result); + return u3m_bail(c3__fail); + } + + result = m3_LoadModule(wasm3_runtime, wasm3_module); + if (result) + { + fprintf(stderr, ERR("load module error: %s"), result); + return u3m_bail(c3__fail); + } + + result = m3_ValidateModule(wasm3_module); + if (result) + { + fprintf(stderr, ERR("validation error: %s"), result); + return u3m_bail(c3__fail); + } + + c3_w n_imports = wasm3_module->numFuncImports; + u3_noun lia_shop = u3at(seed_shop, seed_new); + u3_noun import = u3at(seed_import, seed_new); + + u3_noun acc, map; + u3x_cell(import, &acc, &map); + { + sat.yil_previous = u3_none; + sat.queue = u3_nul; + sat.wasm_module = wasm3_module; + sat.lia_shop = u3qb_flop(lia_shop); + sat.acc = u3k(acc); + sat.map = map; + sat.match = &match; + sat.arrow_yil = u3_none; + sat.susp_list = u3_nul; + sat.resolution = u3_none; + } + + for (c3_w i = 0; i < n_imports; i++) + { + M3Function f = wasm3_module->functions[i]; + const char* mod = f.import.moduleUtf8; + const char* name = f.import.fieldUtf8; + + result = m3_LinkRawFunctionEx( + wasm3_module, mod, name, + NULL, &_link_wasm_with_arrow_map, + &sat + ); + + if (result) + { + fprintf(stderr, ERR("link error: %s"), result); + return u3m_bail(c3__fail); + } + } + + result = m3_CompileModule(wasm3_module); + if (result) + { + fprintf(stderr, ERR("compilation error: %s"), result); + return u3m_bail(c3__fail); + } + + break; + } + else + { + // escaped, grow arena and retry + if (wasm3_runtime) + { + u3a_free(wasm3_runtime->memory.mallocated); + } + + if (jmp_i == c3__box) + { + _uw_arena_grow(BoxArena); + _uw_arena_reset(CodeArena); + } + else if (jmp_i == c3__code) + { + _uw_arena_grow(CodeArena); + _uw_arena_reset(BoxArena); + } + else + { + return u3m_bail(c3__fail); + } + + continue; + } + } + + wasm3_runtime->base = BoxArena->buf_y; + wasm3_runtime->base_transient = CodeArena->buf_y; + // sanity check: struct and code allocators should not be used + // when running wasm + m3_SetAllocators(_calloc_bail, _free_bail, _realloc_bail); + m3_SetTransientAllocators(_calloc_bail, _free_bail, _realloc_bail); + + result = m3_RunStart(wasm3_module); + + if (result == m3Err_ComputationBlock) + { + yil = sat.arrow_yil; + sat.arrow_yil = u3_none; + if (yil == u3_none) + { + return u3m_bail(c3__fail); + } + } + else if (_deterministic_trap(result)) + { + fprintf(stderr, WUT("start function call trapped: %s"), result); + yil = u3nc(2, 0); + } + else if (result == m3Err_functionImportMissing) + { + return u3m_bail(c3__exit); + } + else if (result) + { + fprintf(stderr, ERR("start function failed: %s"), result); + return u3m_bail(c3__fail); + } + else + { + u3_noun monad = u3at(seed_past, seed_new); + yil = _reduce_monad(u3k(monad), &sat); + } + } + + _move_state(&sat, seed, seed_new, hint, yil); + } + else + { + sat.is_stateful = 0; + M3Result result; + IM3Environment wasm3_env; + IM3Runtime wasm3_runtime = NULL; + IM3Module wasm3_module; + u3_noun p_octs, q_octs; + + u3_noun octs = u3at(seed_module, seed_new); + u3x_cell(octs, &p_octs, &q_octs); + c3_w bin_len_w = (c3y == u3a_is_cat(p_octs)) ? p_octs + : u3m_bail(c3__fail); + c3_y* bin_y = u3r_bytes_alloc(0, bin_len_w, u3x_atom(q_octs)); + + m3_SetAllocators(u3a_calloc, u3a_free, u3a_realloc); + m3_SetTransientAllocators(u3a_calloc, u3a_free, u3a_realloc); + m3_SetMemoryAllocators(u3a_calloc, u3a_free, u3a_realloc); + + wasm3_env = m3_NewEnvironment(); + if (!wasm3_env) + { + fprintf(stderr, ERR("env is null")); + return u3m_bail(c3__fail); + } + + // 2MB stack + wasm3_runtime = m3_NewRuntime(wasm3_env, 1 << 21, NULL, 0 /* suspend */); + if (!wasm3_runtime) + { + fprintf(stderr, ERR("runtime is null")); + return u3m_bail(c3__fail); + } + + // save the stack to restore it later before calling m3_FreeRuntime + // since it is allocated and freed seperately; no need to do it in + // stateful code branch since there we will allocate and free + // whole arena + + void* stk_u = wasm3_runtime->stack; + + result = m3_ParseModule(wasm3_env, &wasm3_module, bin_y, bin_len_w); + if (result) + { + fprintf(stderr, ERR("parse binary error: %s"), result); + return u3m_bail(c3__fail); + } + + result = m3_LoadModule(wasm3_runtime, wasm3_module); + if (result) + { + fprintf(stderr, ERR("load module error: %s"), result); + return u3m_bail(c3__fail); + } + + result = m3_ValidateModule(wasm3_module); + if (result) + { + fprintf(stderr, ERR("validation error: %s"), result); + return u3m_bail(c3__fail); + } + + c3_w n_imports = wasm3_module->numFuncImports; + u3_noun lia_shop = u3at(seed_shop, seed_new); + u3_noun import = u3at(seed_import, seed_new); + + u3_noun acc, map; + u3x_cell(import, &acc, &map); + { + sat.yil_previous = u3_none; + sat.queue = u3_none; + sat.wasm_module = wasm3_module; + sat.lia_shop = u3qb_flop(lia_shop); + sat.acc = u3k(acc); + sat.map = map; + sat.match = &match; + sat.arrow_yil = u3_none; + sat.susp_list = u3_none; + sat.resolution = u3_none; + } + + for (c3_w i = 0; i < n_imports; i++) + { + M3Function f = wasm3_module->functions[i]; + const char* mod = f.import.moduleUtf8; + const char* name = f.import.fieldUtf8; + + result = m3_LinkRawFunctionEx( + wasm3_module, mod, name, + NULL, &_link_wasm_with_arrow_map, + &sat + ); + + if (result) + { + fprintf(stderr, ERR("link error: %s"), result); + return u3m_bail(c3__fail); + } + } + + // don't compile module since here we don't care about the ordering + // of code pages when we don't suspend, the functions will + // get compiled on call + // + + result = m3_RunStart(wasm3_module); + + if (result == m3Err_ComputationBlock) + { + yil = sat.arrow_yil; + sat.arrow_yil = u3_none; + if (yil == u3_none) + { + return u3m_bail(c3__fail); + } + } + else if (_deterministic_trap(result)) + { + fprintf(stderr, WUT("start function call trapped: %s"), result); + yil = u3nc(2, 0); + } + else if (result == m3Err_functionImportMissing) + { + return u3m_bail(c3__exit); + } + else if (result) + { + fprintf(stderr, ERR("start function failed: %s"), result); + return u3m_bail(c3__fail); + } + else + { + u3_noun monad = u3at(seed_past, seed_new); + yil = _reduce_monad(u3k(monad), &sat); + } + + wasm3_runtime->stack = stk_u; + m3_FreeRuntime(wasm3_runtime); + m3_FreeEnvironment(wasm3_env); + u3a_free(bin_y); + } + + // any of these could be u3_none + // + { + u3z(sat.lia_shop); + u3z(sat.susp_list); + u3z(sat.yil_previous); + u3z(sat.queue); + } + + u3z(match.call_bat); + u3z(match.memread_bat); + u3z(match.memwrite_bat); + u3z(match.call_ext_bat); + u3z(match.try_bat); + u3z(match.catch_bat); + u3z(match.return_bat); + u3z(match.fail_bat); + u3z(match.global_set_bat); + u3z(match.global_get_bat); + u3z(match.mem_grow_bat); + u3z(match.mem_size_bat); + + u3z(match.call_ctx); + u3z(match.memread_ctx); + u3z(match.memwrite_ctx); + u3z(global_set_ctx); + u3z(global_get_ctx); + u3z(mem_grow_ctx); + u3z(mem_size_ctx); + + #ifdef URWASM_SUBROAD + // exit subroad, copying the result + u3_noun pro = u3m_love(u3nc(u3nc(yil, sat.acc), seed_new)); + #else + u3_noun pro = u3nc(u3nc(yil, sat.acc), seed_new); + #endif + + return pro; + +#endif // URWASM_STATEFUL +} + + +u3_weak +u3we_lia_run_once(u3_noun cor) +{ + if (c3__none == u3at(u3x_sam_6, cor)) + { + return u3_none; + } + + #ifdef URWASM_SUBROAD + // enter subroad, 4MB safety buffer + u3m_hate(1 << 20); + #endif + + u3_noun ctx = u3at(ONCE_CTX, cor); + u3r_mug(ctx); + + u3_noun runnable = uw_kick_nock(u3k(ctx), AX_RUNNABLE); + u3_noun arrows = KICK1(uw_kick_nock(u3k(ctx), AX_ARROWS)); + + u3_noun call_script = KICK1(uw_kick_nock(u3k(arrows), AX_CALL)); + u3_noun memread_script = KICK1(uw_kick_nock(u3k(arrows), AX_MEMREAD)); + u3_noun memwrite_script = KICK1(uw_kick_nock(u3k(arrows), AX_MEMWRITE)); + u3_noun call_ext_script = KICK1(uw_kick_nock(u3k(arrows), AX_CALL_EXT)); + u3_noun global_set_script = KICK1(uw_kick_nock(u3k(arrows), AX_GLOBAL_SET)); + u3_noun global_get_script = KICK1(uw_kick_nock(u3k(arrows), AX_GLOBAL_GET)); + u3_noun mem_grow_script = KICK1(uw_kick_nock(u3k(arrows), AX_MEM_GROW)); + u3_noun mem_size_script = uw_kick_nock(u3k(arrows), AX_MEM_SIZE); + u3_noun get_acc_script = uw_kick_nock(u3k(arrows), AX_GET_ACC); + u3_noun set_acc_script = KICK1(uw_kick_nock(u3k(arrows), AX_SET_ACC)); + u3_noun get_all_glob_script = uw_kick_nock(u3k(arrows), AX_GET_ALL_GLOB); + u3_noun set_all_glob_script = KICK1(uw_kick_nock( arrows, AX_SET_ALL_GLOB)); + + u3_noun try_script = KICK2(uw_kick_nock(u3k(runnable), AX_TRY)); + u3_noun catch_script = KICK2(uw_kick_nock(u3k(runnable), AX_CATCH)); + u3_noun return_script = KICK1(uw_kick_nock(u3k(runnable), AX_RETURN)); + u3_noun fail_script = uw_kick_nock( runnable, AX_FAIL); + + u3_noun call_bat = u3k(u3h(call_script)); + u3_noun memread_bat = u3k(u3h(memread_script)); + u3_noun memwrite_bat = u3k(u3h(memwrite_script)); + u3_noun call_ext_bat = u3k(u3h(call_ext_script)); + u3_noun try_bat = u3k(u3h(try_script)); + u3_noun catch_bat = u3k(u3h(catch_script)); + u3_noun return_bat = u3k(u3h(return_script)); + u3_noun fail_bat = u3k(u3h(fail_script)); + u3_noun global_set_bat = u3k(u3h(global_set_script)); + u3_noun global_get_bat = u3k(u3h(global_get_script)); + u3_noun mem_grow_bat = u3k(u3h(mem_grow_script)); + u3_noun mem_size_bat = u3k(u3h(mem_size_script)); + u3_noun get_acc_bat = u3k(u3h(get_acc_script)); + u3_noun set_acc_bat = u3k(u3h(set_acc_script)); + u3_noun get_all_glob_bat = u3k(u3h(get_all_glob_script)); + u3_noun set_all_glob_bat = u3k(u3h(set_all_glob_script)); + + u3_noun call_ctx = u3k(u3at(ARROW_CTX, call_script)); + u3_noun memread_ctx = u3k(u3at(ARROW_CTX, memread_script)); + u3_noun memwrite_ctx = u3k(u3at(ARROW_CTX, memwrite_script)); + u3_noun global_set_ctx = u3k(u3at(ARROW_CTX, global_set_script)); + u3_noun global_get_ctx = u3k(u3at(ARROW_CTX, global_get_script)); + u3_noun mem_grow_ctx = u3k(u3at(ARROW_CTX, mem_grow_script)); + u3_noun mem_size_ctx = u3k(u3at(MONAD_CTX, mem_size_script)); + u3_noun get_all_glob_ctx = u3k(u3at(MONAD_CTX, get_all_glob_script)); + u3_noun set_all_glob_ctx = u3k(u3at(ARROW_CTX, set_all_glob_script)); + + u3z(call_script); + u3z(memread_script); + u3z(memwrite_script); + u3z(call_ext_script); + u3z(try_script); + u3z(catch_script); + u3z(return_script); + u3z(fail_script); + u3z(global_set_script); + u3z(global_get_script); + u3z(mem_grow_script); + u3z(mem_size_script); + u3z(get_acc_script); + u3z(set_acc_script); + u3z(get_all_glob_script); + u3z(set_all_glob_script); + + + match_data_struct match = { + call_bat, + memread_bat, + memwrite_bat, + call_ext_bat, + try_bat, + catch_bat, + return_bat, + fail_bat, + global_set_bat, + global_get_bat, + mem_grow_bat, + mem_size_bat, + get_acc_bat, + set_acc_bat, + get_all_glob_bat, + set_all_glob_bat, + // + call_ctx, + memread_ctx, + memwrite_ctx, + global_set_ctx, + global_get_ctx, + mem_grow_ctx, + mem_size_ctx, + get_all_glob_ctx, + set_all_glob_ctx, + }; + + u3_noun octs = u3at(u3x_sam_4, cor); + u3_noun p_octs, q_octs; + u3x_cell(octs, &p_octs, &q_octs); + + c3_w bin_len_w = (c3y == u3a_is_cat(p_octs)) ? p_octs : u3m_bail(c3__fail); + c3_y* bin_y = u3r_bytes_alloc(0, bin_len_w, u3x_atom(q_octs)); + + M3Result result; + + m3_SetAllocators(u3a_calloc, u3a_free, u3a_realloc); + m3_SetTransientAllocators(u3a_calloc, u3a_free, u3a_realloc); + m3_SetMemoryAllocators(u3a_calloc, u3a_free, u3a_realloc); + + IM3Environment wasm3_env = m3_NewEnvironment(); + if (!wasm3_env) + { + fprintf(stderr, ERR("env is null")); + return u3m_bail(c3__fail); + } + + // 2MB stack + IM3Runtime wasm3_runtime = m3_NewRuntime( + wasm3_env, + 1 << 21, + NULL, + 0 /* suspend */ + ); + if (!wasm3_runtime) + { + fprintf(stderr, ERR("runtime is null")); + return u3m_bail(c3__fail); + } + + void* stk_u = wasm3_runtime->stack; + + IM3Module wasm3_module; + result = m3_ParseModule(wasm3_env, &wasm3_module, bin_y, bin_len_w); + if (result) + { + fprintf(stderr, ERR("parse binary error: %s"), result); + return u3m_bail(c3__fail); + } + + result = m3_LoadModule(wasm3_runtime, wasm3_module); + if (result) + { + fprintf(stderr, ERR("load module error: %s"), result); + return u3m_bail(c3__fail); + } + + result = m3_ValidateModule(wasm3_module); + if (result) + { + fprintf(stderr, ERR("validation error: %s"), result); + return u3m_bail(c3__fail); + } + + c3_w n_imports = wasm3_module->numFuncImports; + u3_noun monad = u3at(u3x_sam_7, cor); + u3_noun import = u3at(u3x_sam_5, cor); + + u3_noun acc, map; + u3x_cell(import, &acc, &map); + + lia_state sat = { + wasm3_module, + u3_nul, + u3k(acc), + map, + &match, + u3_none, + u3_none, + u3_none + }; + + sat.is_stateful = 0; + + for (c3_w i = 0; i < n_imports; i++) + { + M3Function f = wasm3_module->functions[i]; + const char * mod = f.import.moduleUtf8; + const char * name = f.import.fieldUtf8; + + result = m3_LinkRawFunctionEx( + wasm3_module, mod, name, + NULL, &_link_wasm_with_arrow_map, + (void *)&sat + ); + + if (result) + { + fprintf(stderr, ERR("link error: %s"), result); + return u3m_bail(c3__fail); + } + } + + u3_noun yil; + + result = m3_RunStart(wasm3_module); + + if (result == m3Err_ComputationBlock) + { + yil = sat.arrow_yil; + sat.arrow_yil = u3_none; + if (yil == u3_none) + { + return u3m_bail(c3__fail); + } + } + else if (_deterministic_trap(result)) + { + fprintf(stderr, WUT("start function call trapped: %s"), result); + yil = u3nc(2, 0); + } + else if (result == m3Err_functionImportMissing) + { + return u3m_bail(c3__exit); + } + else if (result) + { + fprintf(stderr, ERR("start function failed: %s"), result); + return u3m_bail(c3__fail); + } + else + { + yil = _reduce_monad(u3k(monad), &sat); + } + + wasm3_runtime->stack = stk_u; + m3_FreeRuntime(wasm3_runtime); + m3_FreeEnvironment(wasm3_env); + + u3a_free(bin_y); + + u3z(match.call_bat); + u3z(match.memread_bat); + u3z(match.memwrite_bat); + u3z(match.call_ext_bat); + u3z(match.try_bat); + u3z(match.catch_bat); + u3z(match.return_bat); + u3z(match.fail_bat); + u3z(match.global_set_bat); + u3z(match.global_get_bat); + u3z(match.mem_grow_bat); + u3z(match.mem_size_bat); + u3z(match.get_acc_bat); + u3z(match.set_acc_bat); + u3z(match.get_all_glob_bat); + u3z(match.set_all_glob_bat); + + u3z(match.call_ctx); + u3z(match.memread_ctx); + u3z(match.memwrite_ctx); + u3z(global_set_ctx); + u3z(global_get_ctx); + u3z(mem_grow_ctx); + u3z(mem_size_ctx); + u3z(get_all_glob_ctx); + u3z(set_all_glob_ctx); + + #ifdef URWASM_SUBROAD + // exit subroad, copying the result + u3_noun pro = u3m_love(u3nc(yil, sat.acc)); + #else + u3_noun pro = u3nc(yil, sat.acc); + #endif + + return pro; +} diff --git a/vere/pkg/noun/jets/e/zlib.c b/vere/pkg/noun/jets/e/zlib.c new file mode 100644 index 0000000..89937df --- /dev/null +++ b/vere/pkg/noun/jets/e/zlib.c @@ -0,0 +1,225 @@ +/// @file + +#include <allocate.h> +#include <stdio.h> +#include "zlib.h" + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +static void* +zlib_malloc(voidpf opaque, uInt items, uInt size) +{ + size_t len = items * size; + void* result = u3a_malloc(len); + return result; +} + +static void +zlib_free(voidpf opaque, voidpf address) +{ + u3a_free(address); +} + +u3_noun +_decompress(u3_atom pos, u3_noun octs, int window_bits) +{ + u3_atom p_octs = u3h(octs); + u3_atom q_octs = u3t(octs); + + c3_w p_octs_w, pos_w; + + if ( c3n == u3r_safe_word(p_octs, &p_octs_w) ) { + return u3_none; + } + if (c3n == u3r_safe_word(pos, &pos_w)) { + return u3_none; + } + + c3_w len_w = u3r_met(3, q_octs); + + int leading_zeros = 0; + + if (p_octs_w > len_w) { + leading_zeros = p_octs_w - len_w; + } + else { + len_w = p_octs_w; + } + + // Bytestream exhausted + // + if (pos_w >= len_w) { + return u3_none; + } + + c3_y* input; + + if (c3y == u3a_is_cat(q_octs)) { + input = (c3_y*)&q_octs + pos_w; + } + else { + u3a_atom* vat_u = u3a_to_ptr(q_octs); + input = (c3_y*)vat_u->buf_w + pos_w; + } + + int ret; + z_stream strm; + + if (pos_w < len_w) { + strm.avail_in = (len_w - pos_w); + } + else { + strm.avail_in = 0; + } + + strm.zalloc = zlib_malloc; + strm.zfree = zlib_free; + strm.opaque = Z_NULL; + strm.next_in = input; + + ret = inflateInit2(&strm, window_bits); + + if (ret != Z_OK) { + u3l_log("%i", ret); + u3l_log("%s", strm.msg); + return u3m_bail(c3__exit); + } + + c3_w chunk_w = len_w / 10; + u3i_slab sab_u; + +#define INIT_SZ 16384 + strm.avail_out = INIT_SZ; + u3i_slab_init(&sab_u, 3, INIT_SZ); + strm.next_out = sab_u.buf_y; + + void* this_address = strm.next_out; + +#define ZEROS_SZ 256 + c3_y zeros[ZEROS_SZ]; + + if (leading_zeros) { + memset(zeros, 0, ZEROS_SZ); + } + + while ((ret = inflate(&strm, Z_FINISH)) == Z_BUF_ERROR) { + + // Output exhausted: reallocate + // + if (strm.avail_out == 0) { + strm.avail_out = chunk_w; + + u3i_slab_grow(&sab_u, 3, strm.total_out + chunk_w); + strm.next_out = sab_u.buf_y + strm.total_out; + } + + // Input exhausted: input leading zeros? + // + if (strm.avail_in == 0) { + + if (leading_zeros) { + // Position in the stream exceeded atom bytes, + // but is still below stream length + // + if (strm.total_in + pos_w >= len_w + && strm.total_in + pos_w < p_octs_w) { + + c3_w rem_w = p_octs_w - (strm.total_in + pos_w); + strm.next_in = zeros; + + if (rem_w > ZEROS_SZ) { + strm.avail_in = ZEROS_SZ; + } + else { + strm.avail_in = rem_w; + } + } + else { + u3l_log("%i", ret); + u3l_log("%s", strm.msg); + inflateEnd(&strm); + u3i_slab_free(&sab_u); + return u3m_bail(c3__exit); + } + } + else { + u3l_log("%i", ret); + u3l_log("%s", strm.msg); + inflateEnd(&strm); + u3i_slab_free(&sab_u); + return u3m_bail(c3__exit); + } + } + } + if (ret != Z_STREAM_END) { + u3l_log("%i", ret); + u3l_log("%s", strm.msg); + inflateEnd(&strm); + u3i_slab_free(&sab_u); + return u3m_bail(c3__exit); + } + ret = inflateEnd(&strm); + + if (ret != Z_OK) { + u3l_log("%i", ret); + u3l_log("%s", strm.msg); + u3i_slab_free(&sab_u); + return u3m_bail(c3__exit); + } + + u3_noun decompressed_octs = u3nc(strm.total_out, u3i_slab_mint(&sab_u)); + u3_noun new_pos = pos_w + strm.total_in; + u3_noun new_stream = u3nc(u3i_word(new_pos), u3k(octs)); + + return u3nc(decompressed_octs, new_stream); +} + +u3_noun +u3qe_decompress_gzip(u3_atom pos, u3_noun octs) +{ + return _decompress(pos, octs, 31); +} +u3_noun +u3qe_decompress_zlib(u3_atom pos, u3_noun octs) +{ + return _decompress(pos, octs, 15); +} + +u3_noun +u3we_decompress_gzip(u3_noun cor) +{ + u3_atom pos; + u3_noun octs; + + u3_noun a = u3r_at(u3x_sam, cor); + u3x_cell(a, &pos, &octs); + + if(_(u3a_is_atom(pos)) && _(u3a_is_cell(octs))) { + return u3qe_decompress_gzip(pos, octs); + } + + else { + return u3m_bail(c3__exit); + } +} + +u3_noun +u3we_decompress_zlib(u3_noun cor) +{ + u3_atom pos; + u3_noun octs; + + u3_noun a = u3r_at(u3x_sam, cor); + u3x_cell(a, &pos, &octs); + + if(_(u3a_is_atom(pos)) && _(u3a_is_cell(octs))) { + return u3qe_decompress_zlib(pos, octs); + } + + else { + return u3m_bail(c3__exit); + } +} |