diff --git a/Makefile b/Makefile index 508b225994..2e5d49b252 100644 --- a/Makefile +++ b/Makefile @@ -212,6 +212,7 @@ J_E_OFILES=\ jets/e/parse.o \ jets/e/rd.o \ jets/e/rs.o \ + jets/e/rq.o \ jets/e/repg.o \ jets/e/rexp.o \ jets/e/rub.o \ diff --git a/include/jets/q.h b/include/jets/q.h index 89c22be6e1..259beefd96 100644 --- a/include/jets/q.h +++ b/include/jets/q.h @@ -134,6 +134,17 @@ u3_noun u3qet_gte(u3_atom, u3_atom); u3_noun u3qet_gth(u3_atom, u3_atom); + u3_noun u3qeq_add(u3_atom, u3_atom); + u3_noun u3qeq_sub(u3_atom, u3_atom); + u3_noun u3qeq_mul(u3_atom, u3_atom); + u3_noun u3qeq_div(u3_atom, u3_atom); + u3_noun u3qeq_sqt(u3_atom); + u3_noun u3qeq_fma(u3_atom, u3_atom, u3_atom); + u3_noun u3qeq_lth(u3_atom, u3_atom); + u3_noun u3qeq_lte(u3_atom, u3_atom); + u3_noun u3qeq_equ(u3_atom, u3_atom); + u3_noun u3qeq_gte(u3_atom, u3_atom); + u3_noun u3qeq_gth(u3_atom, u3_atom); /** Tier 6. **/ diff --git a/include/jets/w.h b/include/jets/w.h index f0b207a575..b3699e7975 100644 --- a/include/jets/w.h +++ b/include/jets/w.h @@ -163,6 +163,17 @@ u3_noun u3wet_gte(u3_noun); u3_noun u3wet_gth(u3_noun); + u3_noun u3weq_add(u3_noun); + u3_noun u3weq_sub(u3_noun); + u3_noun u3weq_mul(u3_noun); + u3_noun u3weq_div(u3_noun); + u3_noun u3weq_sqt(u3_noun); + u3_noun u3weq_fma(u3_noun); + u3_noun u3weq_lth(u3_noun); + u3_noun u3weq_lte(u3_noun); + u3_noun u3weq_equ(u3_noun); + u3_noun u3weq_gte(u3_noun); + u3_noun u3weq_gth(u3_noun); /** Tier 6. **/ diff --git a/jets/e/rq.c b/jets/e/rq.c new file mode 100644 index 0000000000..71c874f748 --- /dev/null +++ b/jets/e/rq.c @@ -0,0 +1,428 @@ +/* j/e/rq.c +** +*/ +#include "all.h" +#include "softfloat.h" + +#define QUADNAN 0x7fff800000000000 + + union quad { + float128_t* q; + c3_w* c; + }; + +/* functions +*/ + 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; + } + } + +/* add +*/ + u3_noun + u3qeq_add(u3_atom a, u3_atom b) + { + union quad c, d, e; + c.c = u3a_walloc(4); + d.c = u3a_walloc(4); + e.c = u3a_walloc(4); + + 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); + u3a_wfree(c.c); + u3a_wfree(d.c); + u3a_wfree(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); + } + } + +/* sub +*/ + u3_noun + u3qeq_sub(u3_atom a, u3_atom b) + { + union quad c, d, e; + c.c = u3a_walloc(4); + d.c = u3a_walloc(4); + e.c = u3a_walloc(4); + + 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); + u3a_wfree(c.c); + u3a_wfree(d.c); + u3a_wfree(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); + } + } + +/* mul +*/ + u3_noun + u3qeq_mul(u3_atom a, u3_atom b) + { + union quad c, d, e; + c.c = u3a_walloc(4); + d.c = u3a_walloc(4); + e.c = u3a_walloc(4); + + 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); + u3a_wfree(c.c); + u3a_wfree(d.c); + u3a_wfree(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); + } + } + +/* div +*/ + u3_noun + u3qeq_div(u3_atom a, u3_atom b) + { + union quad c, d, e; + c.c = u3a_walloc(4); + d.c = u3a_walloc(4); + e.c = u3a_walloc(4); + + 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); + u3a_wfree(c.c); + u3a_wfree(d.c); + u3a_wfree(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); + } + } + +/* sqt +*/ + u3_noun + u3qeq_sqt(u3_atom a) + { + union quad c, d; + c.c = u3a_walloc(4); + d.c = u3a_walloc(4); + + 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); + u3a_wfree(c.c); + u3a_wfree(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); + } + } + +/* fma +*/ + u3_noun + u3qeq_fma(u3_atom a, u3_atom b, u3_atom c) + { + union quad d, e, f, g; + d.c = u3a_walloc(4); + e.c = u3a_walloc(4); + f.c = u3a_walloc(4); + g.c = u3a_walloc(4); + + 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); + u3a_wfree(d.c); + u3a_wfree(e.c); + u3a_wfree(f.c); + u3a_wfree(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); + } + } + +/* lth +*/ + u3_noun + u3qeq_lth(u3_atom a, u3_atom b) + { + union quad c, d; + c.c = u3a_walloc(4); + d.c = u3a_walloc(4); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_lt(c.q, d.q)); + + u3a_wfree(c.c); + u3a_wfree(d.c); + 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 = u3a_walloc(4); + d.c = u3a_walloc(4); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_le(c.q, d.q)); + + u3a_wfree(c.c); + u3a_wfree(d.c); + 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 = u3a_walloc(4); + d.c = u3a_walloc(4); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_eq(c.q, d.q)); + + u3a_wfree(c.c); + u3a_wfree(d.c); + 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 = u3a_walloc(4); + d.c = u3a_walloc(4); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_le(d.q, c.q)); + + u3a_wfree(c.c); + u3a_wfree(d.c); + 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 = u3a_walloc(4); + d.c = u3a_walloc(4); + + u3r_words(0, 4, c.c, a); + u3r_words(0, 4, d.c, b); + c3_o e = __(f128M_lt(d.q, c.q)); + + u3a_wfree(c.c); + u3a_wfree(d.c); + 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/jets/tree.c b/jets/tree.c index fe76c27ade..086b128106 100644 --- a/jets/tree.c +++ b/jets/tree.c @@ -255,6 +255,32 @@ static u3j_core _mood__hoon__rs_d[] = {} }; +static u3j_harm _mood__hoon__rq_add_a[] = {{".2", u3weq_add}, {}}; +static u3j_harm _mood__hoon__rq_sub_a[] = {{".2", u3weq_sub}, {}}; +static u3j_harm _mood__hoon__rq_mul_a[] = {{".2", u3weq_mul}, {}}; +static u3j_harm _mood__hoon__rq_div_a[] = {{".2", u3weq_div}, {}}; +static u3j_harm _mood__hoon__rq_sqt_a[] = {{".2", u3weq_sqt}, {}}; +static u3j_harm _mood__hoon__rq_fma_a[] = {{".2", u3weq_fma}, {}}; +static u3j_harm _mood__hoon__rq_lth_a[] = {{".2", u3weq_lth}, {}}; +static u3j_harm _mood__hoon__rq_lte_a[] = {{".2", u3weq_lte}, {}}; +static u3j_harm _mood__hoon__rq_equ_a[] = {{".2", u3weq_equ}, {}}; +static u3j_harm _mood__hoon__rq_gte_a[] = {{".2", u3weq_gte}, {}}; +static u3j_harm _mood__hoon__rq_gth_a[] = {{".2", u3weq_gth}, {}}; +static u3j_core _mood__hoon__rq_d[] = + { { "add", _mood__hoon__rq_add_a }, + { "sub", _mood__hoon__rq_sub_a }, + { "mul", _mood__hoon__rq_mul_a }, + { "div", _mood__hoon__rq_div_a }, + { "sqt", _mood__hoon__rq_sqt_a }, + { "fma", _mood__hoon__rq_fma_a }, + { "lth", _mood__hoon__rq_lth_a }, + { "lte", _mood__hoon__rq_lte_a }, + { "equ", _mood__hoon__rq_equ_a }, + { "gte", _mood__hoon__rq_gte_a }, + { "gth", _mood__hoon__rq_gth_a }, + {} + }; + static u3j_harm _mood__hoon__coed__ed_puck_a[] = {{".2", u3wee_puck}, {}}; static u3j_harm _mood__hoon__coed__ed_sign_a[] = {{".2", u3wee_sign}, {}}; static u3j_harm _mood__hoon__coed__ed_veri_a[] = {{".2", u3wee_veri}, {}}; @@ -482,6 +508,7 @@ static u3j_core _mood__hoon_d[] = { "rd", 0, _mood__hoon__rd_d }, { "rs", 0, _mood__hoon__rs_d }, + { "rq", 0, _mood__hoon__rq_d }, { "og", 0, _mood__hoon__og_d }, { "coed", 0, _mood__hoon__coed_d }, { "scr", 0, _mood__hoon__scr_d },