From d80503a4027565125e8f826752f17ee886e0fae0 Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Wed, 27 Sep 2017 17:47:26 -0700 Subject: [PATCH] Some missing files. --- jets/e/rh.c | 390 +++++++++++++++++++++++++++++++++++++++++++++++ jets/f/help.c | 31 ++++ jets/f/ut_peel.c | 55 +++++++ 3 files changed, 476 insertions(+) create mode 100644 jets/e/rh.c create mode 100644 jets/f/help.c create mode 100644 jets/f/ut_peel.c diff --git a/jets/e/rh.c b/jets/e/rh.c new file mode 100644 index 000000000..96c2f2f74 --- /dev/null +++ b/jets/e/rh.c @@ -0,0 +1,390 @@ +/* j/e/rh.c +** +*/ +#include "all.h" +#include "softfloat.h" + +#define HALFNAN 0x7e00 + + union half { + float16_t h; + c3_s c; + }; + +/* functions +*/ + 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/jets/f/help.c b/jets/f/help.c new file mode 100644 index 000000000..e657e2d3b --- /dev/null +++ b/jets/f/help.c @@ -0,0 +1,31 @@ +/* j/6/help.c +** +*/ +#include "all.h" + + +/* functions +*/ + u3_noun + u3qf_help(u3_noun sag, + u3_noun tip) + { + if ( c3__void == tip ) { + return c3__void; + } + else return u3nt(c3__help, + u3k(sag), + u3k(tip)); + } + u3_noun + u3wf_help(u3_noun cor) + { + u3_noun sag, tip; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &sag, u3x_sam_3, &tip, 0) ) { + return u3m_bail(c3__fail); + } else { + return u3qf_help(sag, tip); + } + } + diff --git a/jets/f/ut_peel.c b/jets/f/ut_peel.c new file mode 100644 index 000000000..717a62543 --- /dev/null +++ b/jets/f/ut_peel.c @@ -0,0 +1,55 @@ +/* j/6/ut_peel.c +** +*/ +#include "all.h" + + +/* logic +*/ + u3_noun + _cqfu_peel(u3_noun van, + u3_noun sut, + u3_noun way, + u3_noun met) + { + if ( c3__gold == met ) { + return u3nc(c3y, c3y); + } + else switch ( way ) { + default: return u3m_bail(c3__fail); + + case c3__both: return u3nc(c3n, c3n); + case c3__free: return u3nc(c3y, c3y); + case c3__read: return u3nc(((met == c3__zinc) ? c3y : c3n), c3n); + case c3__rite: return u3nc(((met == c3__iron) ? c3y : c3n), c3n); + } + } + +/* boilerplate +*/ + u3_noun + u3wfu_peel(u3_noun cor) + { + u3_noun sut, way, met, van; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &way, + u3x_sam_3, &met, + u3x_con, &van, + 0)) || + (u3_none == (sut = u3r_at(u3x_sam, van))) ) + { + return u3m_bail(c3__fail); + } else { + return _cqfu_peel(van, sut, way, met); + } + } + + u3_noun + u3qfu_peel(u3_noun van, + u3_noun sut, + u3_noun way, + u3_noun met) + { + return _cqfu_peel(van, sut, way, met); + } +