mirror of
https://github.com/urbit/shrub.git
synced 2024-12-01 06:35:32 +03:00
e2bf68ab7e
This reverts commit 04caeff12f5e471519082b1c5f3020943df136db. Medical science made some advances by leaps and bounds. The nash code is more aggressive with the allocator and leaves more garbage around for e.g. u2_term_io_init to trip over.
991 lines
18 KiB
C
991 lines
18 KiB
C
/* f/coal.c
|
|
**
|
|
** This file is in the public domain.
|
|
*/
|
|
#include "all.h"
|
|
#include <fcntl.h>
|
|
#include <sys/ioctl.h>
|
|
#include <sys/stat.h>
|
|
#include <dirent.h>
|
|
|
|
#include "../gen164/pit.h"
|
|
|
|
/** Jet dependencies. Minimize these.
|
|
**/
|
|
# define Pt5Y k_164__mood__hoon
|
|
|
|
/** Jet dependencies. Minimize these.
|
|
**/
|
|
# define Pt3Y k_164__mood__hoon
|
|
# define Pt4Y k_164__mood__hoon
|
|
# define Pt5Y k_164__mood__hoon
|
|
|
|
u2_noun j2_mbc(Pt3Y, gor)(u2_wire, u2_noun a, u2_noun b);
|
|
u2_noun j2_mcc(Pt4Y, by, get)(u2_wire, u2_noun a, u2_noun b);
|
|
u2_noun j2_mcc(Pt4Y, by, put)(u2_wire, u2_noun a, u2_noun b, u2_noun c);
|
|
u2_noun j2_mby(Pt5Y, jam)(u2_wire, u2_noun a);
|
|
u2_noun j2_mby(Pt5Y, trip)(u2_wire, u2_noun a);
|
|
|
|
# define _coal_cue j2_mby(Pt5Y, cue)
|
|
# define _coal_jam j2_mby(Pt5Y, jam)
|
|
# define _coal_trip j2_mby(Pt5Y, trip)
|
|
|
|
# define _coal_gor j2_mbc(Pt3Y, gor)
|
|
# define _coal_by_gas j2_mcc(Pt4Y, by, gas)
|
|
# define _coal_by_get j2_mcc(Pt4Y, by, get)
|
|
# define _coal_by_has j2_mcc(Pt4Y, in, has)
|
|
# define _coal_by_put j2_mcc(Pt4Y, by, put)
|
|
# define _coal_in_gas j2_mcc(Pt4Y, in, gas)
|
|
# define _coal_in_has j2_mcc(Pt4Y, in, has)
|
|
# define _coal_in_tap j2_mcc(Pt4Y, in, tap)
|
|
|
|
|
|
/* u2_cf_path(): assemble local path with noun thap and ext.
|
|
*/
|
|
/* _cf_path_1: write at/inpath.
|
|
*/
|
|
static c3_w
|
|
_cf_path_1(c3_c* buf_c,
|
|
c3_w pos_w,
|
|
u2_noun hut) // retain
|
|
{
|
|
if ( u2_no == u2_cr_du(hut) ) {
|
|
c3_w met_w = u2_cr_met(3, hut);
|
|
|
|
if ( buf_c ) u2_cr_bytes(0, met_w, (c3_y*)(buf_c + pos_w), hut);
|
|
return (pos_w + met_w);
|
|
}
|
|
else {
|
|
c3_w met_w = u2_cr_met(3, u2h(hut));
|
|
c3_w end_w = _cf_path_1(buf_c, pos_w, u2t(hut));
|
|
u2_noun san = u2h(hut);
|
|
|
|
if ( buf_c ) buf_c[end_w] = '/';
|
|
end_w++;
|
|
|
|
// little security thing - last ditch
|
|
//
|
|
if ( c3_s2('.', '.') == san ) {
|
|
san = c3_s3('.','.','.');
|
|
}
|
|
if ( buf_c ) u2_cr_bytes(0, met_w, (c3_y*)(buf_c + end_w), san);
|
|
end_w += met_w;
|
|
|
|
return end_w;
|
|
}
|
|
}
|
|
|
|
u2_noun
|
|
u2_cf_path(c3_c* top_c,
|
|
c3_c* ext_c,
|
|
u2_noun tah)
|
|
{
|
|
c3_w top_w = strlen(top_c);
|
|
c3_w len_w = _cf_path_1(0, (top_w + 1), tah);
|
|
c3_w buf_w = len_w + (ext_c ? (1 + strlen(ext_c)) : 0);
|
|
c3_c* buf_c = c3_malloc(buf_w + 1);
|
|
c3_w pos_w;
|
|
u2_noun pas;
|
|
|
|
strncpy(buf_c, top_c, buf_w);
|
|
buf_c[buf_w] = '\0';
|
|
pos_w = top_w;
|
|
buf_c[pos_w++] = '/';
|
|
|
|
pos_w = _cf_path_1(buf_c, pos_w, tah);
|
|
|
|
if ( ext_c ) {
|
|
buf_c[pos_w++] = '.';
|
|
strncpy(buf_c + pos_w, ext_c, buf_w - pos_w);
|
|
} else {
|
|
buf_c[pos_w] = 0;
|
|
}
|
|
|
|
pas = u2_ci_string(buf_c);
|
|
free(buf_c);
|
|
|
|
u2_cz(tah);
|
|
return pas;
|
|
}
|
|
|
|
/* u2_cf_flat_date(): date for `pas`. Unix time * 10^6, or 0.
|
|
*/
|
|
c3_d
|
|
u2_cf_flat_date(u2_noun pas)
|
|
{
|
|
c3_c* pas_c = u2_cr_string(pas);
|
|
struct stat pas_s;
|
|
|
|
u2_cz(pas);
|
|
if ( stat(pas_c, &pas_s) < 0 ) {
|
|
free(pas_c);
|
|
|
|
return 0;
|
|
} else {
|
|
free(pas_c);
|
|
#if defined(U2_OS_linux)
|
|
return ( ((c3_d)pas_s.st_mtime) );
|
|
#elif defined(U2_OS_osx)
|
|
return ( ((c3_d)pas_s.st_mtimespec.tv_sec) +
|
|
((c3_d)(pas_s.st_mtimespec.tv_nsec / 1000)) );
|
|
#elif defined(U2_OS_bsd)
|
|
return ( ((c3_d)pas_s.st_mtim.tv_sec) +
|
|
((c3_d)(pas_s.st_mtim.tv_nsec / 1000)) );
|
|
#else
|
|
#error "port: filetime"
|
|
#endif
|
|
}
|
|
}
|
|
|
|
/* u2_cf_flat_load(): load `mod` at `pas`. Bail on error.
|
|
*/
|
|
u2_weak
|
|
u2_cf_flat_load(u2_noun mod,
|
|
u2_noun pas)
|
|
{
|
|
c3_assert(c3__atom == mod);
|
|
{
|
|
c3_c* pas_c = u2_cr_string(pas);
|
|
c3_i fid_i;
|
|
struct stat sat_s;
|
|
c3_w fln_w;
|
|
c3_c* fil_c;
|
|
u2_atom fil;
|
|
|
|
fid_i = open(pas_c, O_RDONLY, 0644);
|
|
free(pas_c);
|
|
u2_cz(pas);
|
|
|
|
if ( (fid_i < 0) || (fstat(fid_i, &sat_s) < 0) ) {
|
|
perror(pas_c);
|
|
return u2_none;
|
|
}
|
|
|
|
fln_w = sat_s.st_size;
|
|
fil_c = c3_malloc(sat_s.st_size);
|
|
|
|
if ( fln_w != read(fid_i, fil_c, fln_w) ) {
|
|
return u2_none;
|
|
}
|
|
close(fid_i);
|
|
|
|
fil = u2_ci_bytes(fln_w, (c3_y *)fil_c);
|
|
free(fil_c);
|
|
|
|
return fil;
|
|
}
|
|
}
|
|
|
|
/* u2_cf_list(): list all the files in directory `pas`. List of cask.
|
|
*/
|
|
u2_noun
|
|
u2_cf_list(u2_noun pas)
|
|
{
|
|
c3_c* pas_c = u2_cr_string(pas);
|
|
|
|
u2z(pas);
|
|
{
|
|
u2_noun lis = u2_nul;
|
|
DIR *dir_d = opendir(pas_c);
|
|
|
|
if ( !dir_d ) {
|
|
free(pas_c);
|
|
return u2_nul;
|
|
}
|
|
else {
|
|
while ( 1 ) {
|
|
struct dirent ent_n;
|
|
struct dirent *out_n;
|
|
|
|
if ( readdir_r(dir_d, &ent_n, &out_n) != 0 ) {
|
|
perror(pas_c);
|
|
return u2_cm_bail(c3__fail);
|
|
}
|
|
else if ( !out_n ) {
|
|
break;
|
|
}
|
|
else lis = u2nc(u2_ci_string(out_n->d_name), lis);
|
|
}
|
|
|
|
free(pas_c);
|
|
return lis;
|
|
}
|
|
}
|
|
}
|
|
|
|
/* u2_cf_flat_save(): save `som` as `mod` at `pas`.
|
|
*/
|
|
u2_bean
|
|
u2_cf_flat_save(u2_noun mod,
|
|
u2_noun pas,
|
|
u2_noun som)
|
|
{
|
|
c3_assert(c3__atom == mod);
|
|
{
|
|
c3_c* pas_c = u2_cr_string(pas);
|
|
c3_i fid_i;
|
|
c3_w fln_w;
|
|
c3_y* fil_y;
|
|
|
|
fid_i = open(pas_c, O_WRONLY | O_CREAT, 0666);
|
|
free(pas_c);
|
|
u2_cz(pas);
|
|
|
|
if ( fid_i < 0 ) {
|
|
perror(pas_c);
|
|
u2_cz(som);
|
|
return u2_no;
|
|
}
|
|
|
|
fln_w = u2_met(3, som);
|
|
fil_y = c3_malloc(fln_w);
|
|
u2_cr_bytes(0, fln_w, fil_y, som);
|
|
u2_cz(som);
|
|
|
|
if ( fln_w != write(fid_i, fil_y, fln_w) ) {
|
|
return u2_no;
|
|
}
|
|
close(fid_i);
|
|
|
|
return u2_yes;
|
|
}
|
|
}
|
|
|
|
#if 1
|
|
/* u2_cn_mung():
|
|
**
|
|
** Call `(function sample)`.
|
|
*/
|
|
u2_noun
|
|
u2_cn_mung(u2_noun fun,
|
|
u2_noun sam)
|
|
{
|
|
u2_noun pro = u2_bn_mong(u2_Wire, fun, sam);
|
|
|
|
u2_cz(fun);
|
|
return pro;
|
|
}
|
|
#endif
|
|
|
|
/* u2_ci_string():
|
|
**
|
|
** u2_ci_bytes(strlen(a_c), (c3_y *)a_c);
|
|
*/
|
|
u2_atom
|
|
u2_ci_string(const c3_c* a_c)
|
|
{
|
|
return u2_bn_string(u2_Wire, a_c);
|
|
}
|
|
|
|
/* u2_ci_mp(): construct atom from GMP. Caller transfers a_mp.
|
|
*/
|
|
u2_atom
|
|
u2_ci_mp(mpz_t a_mp)
|
|
{
|
|
return u2_rl_mp(u2_Wire, a_mp);
|
|
}
|
|
|
|
/* u2_ci_tape(): from a C string, to a list of bytes.
|
|
*/
|
|
u2_atom
|
|
u2_ci_tape(const c3_c* txt_c)
|
|
{
|
|
if ( !*txt_c ) {
|
|
return u2_nul;
|
|
} else return u2nc(*txt_c, u2_ci_tape(txt_c + 1));
|
|
}
|
|
|
|
/* u2_cr_string(): `a` as malloced C string.
|
|
*/
|
|
c3_c*
|
|
u2_cr_string(u2_atom a)
|
|
{
|
|
c3_w met_w = u2_cr_met(3, a);
|
|
c3_c* str_c = c3_malloc(met_w + 1);
|
|
|
|
u2_cr_bytes(0, met_w, (c3_y*)str_c, a);
|
|
str_c[met_w] = 0;
|
|
return str_c;
|
|
}
|
|
|
|
/* u2_cr_tape(): `a`, a list of bytes, as malloced C string.
|
|
*/
|
|
c3_y*
|
|
u2_cr_tape(u2_noun a)
|
|
{
|
|
u2_noun b;
|
|
c3_w i_w;
|
|
c3_y *a_y;
|
|
|
|
for ( i_w = 0, b=a; u2_yes == u2du(b); i_w++, b=u2t(b) )
|
|
;
|
|
a_y = c3_malloc(i_w + 1);
|
|
|
|
for ( i_w = 0, b=a; u2_yes == u2du(b); i_w++, b=u2t(b) ) {
|
|
a_y[i_w] = u2h(b);
|
|
}
|
|
a_y[i_w] = 0;
|
|
|
|
return a_y;
|
|
}
|
|
|
|
/* u2_ci_bytes():
|
|
**
|
|
** Construct `a` bytes from `b`, LSB first, as an atom.
|
|
*/
|
|
u2_atom
|
|
u2_ci_bytes(c3_w a_w,
|
|
const c3_y* b_y)
|
|
{
|
|
return u2_bn_bytes(u2_Wire, a_w, b_y);
|
|
}
|
|
|
|
/* u2_ci_words():
|
|
**
|
|
** Construct `a` words from `b`, LSW first, as an atom.
|
|
*/
|
|
u2_atom
|
|
u2_ci_words(c3_w a_w,
|
|
const c3_w* b_w)
|
|
{
|
|
return u2_bn_words(u2_Wire, a_w, b_w);
|
|
}
|
|
|
|
/* u2_ci_chubs():
|
|
**
|
|
** Construct `a` double-words from `b`, LSD first, as an atom.
|
|
*/
|
|
u2_atom
|
|
u2_ci_chubs(c3_w a_w,
|
|
const c3_d* b_d)
|
|
{
|
|
// XX considerably suboptimal
|
|
{
|
|
c3_w *b_w = c3_malloc(a_w * 8);
|
|
c3_w i_w;
|
|
u2_atom p;
|
|
|
|
for ( i_w = 0; i_w < a_w; i_w++ ) {
|
|
b_w[(2 * i_w)] = b_d[i_w] & 0xffffffffULL;
|
|
b_w[(2 * i_w) + 1] = b_d[i_w] >> 32ULL;
|
|
}
|
|
p = u2_ci_words((a_w * 2), b_w);
|
|
free(b_w);
|
|
return p;
|
|
}
|
|
}
|
|
|
|
/* u2_cm_trip(): descend into a memory region.
|
|
**
|
|
** Memory allocated in the heap above is senior & frozen.
|
|
*/
|
|
void
|
|
u2_cm_trip()
|
|
{
|
|
#if 0
|
|
if ( u2_no == u2_rl_leap(u2_Wire, c3__rock) ) {
|
|
u2_cm_bail(c3__fail);
|
|
}
|
|
#endif
|
|
}
|
|
|
|
/* u2_cm_chin(): ascend out of a memory region.
|
|
**
|
|
** Memory allocated in the heap below is junior & volatile.
|
|
*/
|
|
void
|
|
u2_cm_chin()
|
|
{
|
|
#if 0
|
|
u2_rl_fall(u2_Wire);
|
|
#endif
|
|
}
|
|
|
|
/* u2_cm_bury(): store fresh or volatile noun `som` to freezer.
|
|
*/
|
|
u2_weak
|
|
u2_cm_bury(u2_weak som)
|
|
{
|
|
if ( u2_none == som ) return som;
|
|
|
|
if ( u2_no == u2_rl_junior(u2_wire_bas_r(u2_Wire), som) ) {
|
|
return som;
|
|
}
|
|
else {
|
|
u2_noun pro = u2_rl_take(u2_wire_bas_r(u2_Wire), som);
|
|
|
|
u2_cz(som);
|
|
return pro;
|
|
}
|
|
}
|
|
|
|
/* u2_cm_rind(): open and produce a new jump buffer.
|
|
*/
|
|
void*
|
|
u2_cm_rind()
|
|
{
|
|
u2_ray kit_r = u2_rl_ralloc(u2_Wire, c3_wiseof(u2_loom_kite));
|
|
|
|
u2_kite_par_r(kit_r) = u2_wire_kit_r(u2_Wire);
|
|
u2_wire_kit_r(u2_Wire) = kit_r;
|
|
|
|
// Save the old stack and actions.
|
|
//
|
|
u2_kite_tax(kit_r) = u2k(u2_wire_tax(u2_Wire));
|
|
u2_kite_don(kit_r) = u2k(u2_wrac_at(u2_Wire, duz.don));
|
|
|
|
return u2_at_cord(u2_kite_buf_r(kit_r), c3_wiseof(jmp_buf));
|
|
}
|
|
|
|
/* _cm_jack(): steal the trace as of the current kite.
|
|
*/
|
|
static u2_noun
|
|
_cm_jack(u2_noun old, u2_noun nuw)
|
|
{
|
|
u2_noun cur = nuw;
|
|
|
|
if ( nuw == old ) {
|
|
u2z(old); return u2_nul;
|
|
}
|
|
else while ( 1 ) {
|
|
if ( u2ft(cur) == old ) {
|
|
u2z(old);
|
|
u2ft(cur) = u2_nul;
|
|
|
|
return nuw;
|
|
} else {
|
|
cur = u2ft(cur);
|
|
}
|
|
}
|
|
}
|
|
|
|
#if 0
|
|
/* _cm_depth()
|
|
*/
|
|
static c3_w
|
|
_cm_depth(u2_noun old, u2_noun nuw)
|
|
{
|
|
c3_w dep_w = 0;
|
|
|
|
while ( nuw != old ) {
|
|
c3_assert(u2_yes == u2du(nuw));
|
|
nuw = u2t(nuw);
|
|
|
|
dep_w++;
|
|
}
|
|
return dep_w;
|
|
}
|
|
#endif
|
|
|
|
/* u2_cm_wail(): produce and reset the local trace, without bailing.
|
|
*/
|
|
u2_noun
|
|
u2_cm_wail()
|
|
{
|
|
u2_ray kit_r = u2_wire_kit_r(u2_Wire);
|
|
u2_noun old = u2_kite_tax(u2_wire_kit_r(u2_Wire));
|
|
u2_noun nuw = u2_wire_tax(u2_Wire);
|
|
u2_noun jaq;
|
|
|
|
jaq = _cm_jack(old, nuw);
|
|
|
|
// c3_assert(1 == u2_rl_refs(u2_Wire, old));
|
|
u2_wire_tax(u2_Wire) = old;
|
|
u2_kite_tax(kit_r) = u2k(old);
|
|
// c3_assert(1 == u2_rl_refs(u2_Wire, jaq));
|
|
|
|
return jaq;
|
|
}
|
|
|
|
// static c3_w _num = 0;
|
|
|
|
/* u2_cm_bail(): bail out to the local trap. Does not return.
|
|
*/
|
|
extern u2_noun u2_Flag_Abort;
|
|
u2_noun
|
|
u2_cm_bail(c3_l how_l)
|
|
{
|
|
u2_ray kit_r = u2_wire_kit_r(u2_Wire);
|
|
|
|
if ( u2_yes == u2_Flag_Abort ) {
|
|
if ( c3__fail == how_l ) { c3_assert(0); }
|
|
c3_assert(0);
|
|
}
|
|
u2_tx_sys_bit(u2_Wire, u2_yes);
|
|
|
|
// fprintf(stderr, "bail\n");
|
|
// if ( _num == 0 ) { c3_assert(0); } else _num--;
|
|
|
|
{
|
|
u2_noun jaq;
|
|
jmp_buf buf_f;
|
|
|
|
// Reset the old stack trace, pulling off the local top.
|
|
//
|
|
jaq = u2_cm_wail();
|
|
|
|
// Reset the old action trace.
|
|
{
|
|
u2z(u2_wrac_at(u2_Wire, duz.don));
|
|
u2_wrac_at(u2_Wire, duz.don) = u2_kite_don(kit_r);
|
|
}
|
|
|
|
// Copy out the jump buffer; free the old kite.
|
|
{
|
|
memcpy((void *)buf_f,
|
|
u2_at_cord(u2_kite_buf_r(kit_r), c3_wiseof(jmp_buf)),
|
|
sizeof(jmp_buf));
|
|
|
|
u2_wire_kit_r(u2_Wire) = u2_kite_par_r(kit_r);
|
|
u2_rl_rfree(u2_Wire, kit_r);
|
|
}
|
|
|
|
// Longjmp with the how-trace pair. XX: no workee with 64-bit nouns.
|
|
//
|
|
{
|
|
_longjmp(buf_f, u2nc(how_l, jaq));
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
/* u2_cm_bowl(): bail out with preset report.
|
|
*/
|
|
u2_noun
|
|
u2_cm_bowl(u2_noun how)
|
|
{
|
|
u2_ray kit_r = u2_wire_kit_r(u2_Wire);
|
|
|
|
u2_tx_sys_bit(u2_Wire, u2_yes);
|
|
|
|
{
|
|
u2_noun jaq;
|
|
jmp_buf buf_f;
|
|
|
|
// Reset the old stack trace, pulling off the local top.
|
|
//
|
|
jaq = u2_cm_wail();
|
|
|
|
// Reset the old action trace.
|
|
{
|
|
u2z(u2_wrac_at(u2_Wire, duz.don));
|
|
u2_wrac_at(u2_Wire, duz.don) = u2_kite_don(kit_r);
|
|
}
|
|
|
|
// Copy out the jump buffer; free the old kite.
|
|
{
|
|
memcpy((void *)buf_f,
|
|
u2_at_cord(u2_kite_buf_r(kit_r), c3_wiseof(jmp_buf)),
|
|
sizeof(jmp_buf));
|
|
|
|
u2_wire_kit_r(u2_Wire) = u2_kite_par_r(kit_r);
|
|
u2_rl_rfree(u2_Wire, kit_r);
|
|
}
|
|
|
|
// Longjmp with the how-trace pair. XX: no workee with 64-bit nouns.
|
|
//
|
|
{
|
|
u2z(jaq);
|
|
_longjmp(buf_f, how);
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
/* u2_cm_done(): terminate trap.
|
|
*/
|
|
void
|
|
u2_cm_done()
|
|
{
|
|
u2_ray kit_r = u2_wire_kit_r(u2_Wire);
|
|
|
|
c3_assert(kit_r != 0);
|
|
|
|
u2z(u2_kite_tax(kit_r));
|
|
u2z(u2_kite_don(kit_r));
|
|
u2_wire_kit_r(u2_Wire) = u2_kite_par_r(kit_r);
|
|
|
|
u2_rl_rfree(u2_Wire, kit_r);
|
|
}
|
|
|
|
/* u2_cm_sweep(): return bytes leaked; match bytes saved.
|
|
*/
|
|
c3_w
|
|
u2_cm_sweep(c3_w sav_w)
|
|
{
|
|
return u2_rl_gc_sweep(u2_Wire, sav_w);
|
|
}
|
|
|
|
/* u2_cm_purge(): purge memo cache.
|
|
*/
|
|
void
|
|
u2_cm_purge()
|
|
{
|
|
u2_rl_drain(u2_Wire);
|
|
}
|
|
|
|
/* u2_cm_mark_noun(): mark individual noun.
|
|
*/
|
|
c3_w
|
|
u2_cm_mark_noun(u2_noun som)
|
|
{
|
|
return u2_rl_gc_mark_noun(u2_Wire, som);
|
|
}
|
|
|
|
/* u2_cm_mark_ray(): mark a root for gc (do not use again before gc)
|
|
*/
|
|
c3_w
|
|
u2_cm_mark_ray(u2_ray ray_r)
|
|
{
|
|
return u2_rl_gc_mark_ptr(u2_Wire, ray_r);
|
|
}
|
|
|
|
/* u2_cm_mark_internal(): mark all coal internals
|
|
*/
|
|
c3_w
|
|
u2_cm_mark_internal()
|
|
{
|
|
return u2_wr_mark(u2_Wire);
|
|
}
|
|
|
|
/* u2_cm_trac(): extract and clear stack trace.
|
|
*/
|
|
u2_noun
|
|
u2_cm_trac()
|
|
{
|
|
u2_noun tax = u2_wire_tax(u2_Wire);
|
|
|
|
u2_wire_tax(u2_Wire) = u2_nul;
|
|
return tax;
|
|
}
|
|
|
|
/* u2_cm_push(): push `mon` on trace stack.
|
|
*/
|
|
void
|
|
u2_cm_push(u2_noun mon)
|
|
{
|
|
u2_wire_tax(u2_Wire) = u2nc(mon, u2_wire_tax(u2_Wire));
|
|
}
|
|
|
|
/* u2_cm_bean(): push `[%bean roc]` on trace stack.
|
|
*/
|
|
void
|
|
u2_cm_bean(u2_noun roc)
|
|
{
|
|
u2_cm_push(u2nc(c3__bean, roc));
|
|
}
|
|
|
|
/* u2_cm_drop(): drop from meaning stack.
|
|
*/
|
|
void
|
|
u2_cm_drop()
|
|
{
|
|
u2_noun tax = u2_wire_tax(u2_Wire);
|
|
|
|
c3_assert(u2_nul != tax);
|
|
u2_wire_tax(u2_Wire) = u2_ct(u2t(tax));
|
|
u2_cz(tax);
|
|
}
|
|
|
|
/* u2_cm_foul():
|
|
*/
|
|
u2_noun
|
|
u2_cm_foul(const c3_c* err_c)
|
|
{
|
|
u2_cm_bean(u2_ci_string(err_c));
|
|
fprintf(stderr, "foul: %s\n", err_c);
|
|
|
|
return u2_bl_error(u2_Wire, err_c);
|
|
}
|
|
|
|
/* u2_cn_cell(): produce the cell `[a b]`.
|
|
*/
|
|
u2_noun
|
|
u2_cn_cell(u2_noun a,
|
|
u2_noun b)
|
|
{
|
|
return u2_bn_cell(u2_Wire, a, b);
|
|
}
|
|
|
|
/* u2_cn_trel(): produce the cell `[a b c]`.
|
|
*/
|
|
u2_noun
|
|
u2_cn_trel(u2_noun a,
|
|
u2_noun b,
|
|
u2_noun c)
|
|
{
|
|
return u2_bn_trel(u2_Wire, a, b, c);
|
|
}
|
|
|
|
/* u2_cn_qual(): produce the cell `[a b c d]`.
|
|
*/
|
|
u2_noun
|
|
u2_cn_qual(u2_noun a,
|
|
u2_noun b,
|
|
u2_noun c,
|
|
u2_noun d)
|
|
{
|
|
return u2_bn_qual(u2_Wire, a, b, c, d);
|
|
}
|
|
|
|
/* u2_cka_add(): a + b.
|
|
*/
|
|
u2_noun
|
|
u2_cka_add(u2_noun a, u2_noun b)
|
|
{
|
|
u2_noun c = j2_mbc(Pt1, add)(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
return c;
|
|
}
|
|
|
|
/* u2_cka_sub(): a + b.
|
|
*/
|
|
u2_noun
|
|
u2_cka_sub(u2_noun a, u2_noun b)
|
|
{
|
|
u2_noun c = j2_mbc(Pt1, sub)(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
return c;
|
|
}
|
|
|
|
/* u2_cka_gth(): a + b.
|
|
*/
|
|
u2_noun
|
|
u2_cka_gth(u2_noun a, u2_noun b)
|
|
{
|
|
u2_noun c = j2_mbc(Pt1, gth)(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
return c;
|
|
}
|
|
|
|
/* u2_cka_mul(): a * b.
|
|
*/
|
|
u2_noun
|
|
u2_cka_mul(u2_noun a, u2_noun b)
|
|
{
|
|
u2_noun c = j2_mbc(Pt1, mul)(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
return c;
|
|
}
|
|
|
|
/* u2_cka_lte(): a * b.
|
|
*/
|
|
u2_noun
|
|
u2_cka_lte(u2_noun a, u2_noun b)
|
|
{
|
|
u2_noun c = j2_mbc(Pt1, lte)(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
return c;
|
|
}
|
|
|
|
/* u2_ckb_lent(): length of list `a`.
|
|
*/
|
|
u2_noun
|
|
u2_ckb_lent(u2_noun a)
|
|
{
|
|
u2_noun b = j2_mbc(Pt2, lent)(u2_Wire, a);
|
|
|
|
u2_cz(a);
|
|
return b;
|
|
}
|
|
|
|
/* u2_ckb_flop(): reverse list `a`.
|
|
*/
|
|
u2_noun
|
|
u2_ckb_flop(u2_noun a)
|
|
{
|
|
u2_noun b = j2_mbc(Pt2, flop)(u2_Wire, a);
|
|
|
|
u2_cz(a);
|
|
return b;
|
|
}
|
|
|
|
/* u2_ckb_weld(): concatenate lists `a` before `b`.
|
|
*/
|
|
u2_noun
|
|
u2_ckb_weld(u2_noun a, u2_noun b)
|
|
{
|
|
u2_noun c = j2_mbc(Pt2, weld)(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
return c;
|
|
}
|
|
|
|
/* u2_ckc_lsh(): left shift.
|
|
*/
|
|
u2_noun
|
|
u2_ckc_lsh(u2_noun a, u2_noun b, u2_noun c)
|
|
{
|
|
u2_noun d = j2_mbc(Pt3, lsh)(u2_Wire, a, b, c);
|
|
|
|
u2_cz(a); u2_cz(b); u2_cz(c);
|
|
return d;
|
|
}
|
|
|
|
/* u2_ckc_rsh(): right shift.
|
|
*/
|
|
u2_noun
|
|
u2_ckc_rsh(u2_noun a, u2_noun b, u2_noun c)
|
|
{
|
|
u2_noun d = j2_mbc(Pt3, rsh)(u2_Wire, a, b, c);
|
|
|
|
u2_cz(a); u2_cz(b); u2_cz(c);
|
|
return d;
|
|
}
|
|
|
|
/* u2_ckd_by_get(): map get for key `b` in map `a` with u2_none.
|
|
*/
|
|
u2_weak
|
|
u2_ckd_by_get(u2_noun a, u2_noun b)
|
|
{
|
|
u2_noun c = _coal_by_get(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
if ( u2_no == u2_cr_du(c) ) {
|
|
u2_cz(c);
|
|
return u2_none;
|
|
} else {
|
|
u2_noun pro = u2_ct(u2t(c));
|
|
|
|
u2_cz(c);
|
|
return pro;
|
|
}
|
|
}
|
|
|
|
/* u2_ckd_by_got(): map get for key `b` in map `a` with fail.
|
|
*/
|
|
u2_noun
|
|
u2_ckd_by_got(u2_noun a, u2_noun b)
|
|
{
|
|
u2_weak c = u2_ckd_by_get(a, b);
|
|
|
|
if ( u2_none == c ) {
|
|
return u2_cm_bail(c3__exit);
|
|
}
|
|
else return c;
|
|
}
|
|
|
|
/* u2_ckd_by_put(): map put for key `b`, value `c` in map `a`.
|
|
*/
|
|
u2_weak
|
|
u2_ckd_by_put(u2_noun a, u2_noun b, u2_noun c)
|
|
{
|
|
// Bizarre asymmetry in old jets.
|
|
//
|
|
// (Mysterious comment in old glue code.)
|
|
//
|
|
u2_noun pro = _coal_by_put(u2_Wire, a, b, c);
|
|
|
|
u2_cz(a); u2_cz(b); u2_cz(c);
|
|
return pro;
|
|
}
|
|
|
|
/* u2_ckd_by_gas(): list to map.
|
|
*/
|
|
u2_noun
|
|
u2_ckd_by_gas(u2_noun a, u2_noun b)
|
|
{
|
|
u2_weak c = _coal_by_gas(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
if ( u2_none == c ) {
|
|
return u2_cm_bail(c3__exit);
|
|
}
|
|
else return c;
|
|
}
|
|
|
|
/* u2_ckd_in_gas(): list to map.
|
|
*/
|
|
u2_noun
|
|
u2_ckd_in_gas(u2_noun a, u2_noun b)
|
|
{
|
|
u2_weak c = _coal_in_gas(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
if ( u2_none == c ) {
|
|
return u2_cm_bail(c3__exit);
|
|
}
|
|
else return c;
|
|
}
|
|
|
|
/* u2_ckd_by_has(): test for presence.
|
|
*/
|
|
u2_bean
|
|
u2_ckd_by_has(u2_noun a, u2_noun b)
|
|
{
|
|
u2_weak c = _coal_by_has(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
if ( u2_none == c ) {
|
|
return u2_cm_bail(c3__exit);
|
|
}
|
|
else return c;
|
|
}
|
|
|
|
/* u2_ckd_in_has(): test for presence.
|
|
*/
|
|
u2_bean
|
|
u2_ckd_in_has(u2_noun a, u2_noun b)
|
|
{
|
|
u2_weak c = _coal_in_has(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
if ( u2_none == c ) {
|
|
return u2_cm_bail(c3__exit);
|
|
}
|
|
else return c;
|
|
}
|
|
|
|
/* u2_ckd_in_tap(): map/set convert to list. (solves by_tap also.)
|
|
*/
|
|
u2_noun
|
|
u2_ckd_in_tap(u2_noun a, u2_noun b)
|
|
{
|
|
u2_weak c = _coal_in_tap(u2_Wire, a, b);
|
|
|
|
u2_cz(a); u2_cz(b);
|
|
if ( u2_none == c ) {
|
|
return u2_cm_bail(c3__exit);
|
|
}
|
|
else return c;
|
|
}
|
|
|
|
/* u2_cke_cue(): expand saved pill.
|
|
*/
|
|
|
|
u2_noun
|
|
u2_cke_cue(u2_atom a)
|
|
{
|
|
u2_noun b = _coal_cue(u2_Wire, a);
|
|
|
|
u2_cz(a);
|
|
return b;
|
|
}
|
|
|
|
/* u2_cke_jam(): pack noun as atom.
|
|
*/
|
|
u2_atom
|
|
u2_cke_jam(u2_noun a)
|
|
{
|
|
u2_atom b = _coal_jam(u2_Wire, a);
|
|
|
|
u2_cz(a);
|
|
return b;
|
|
}
|
|
|
|
/* u2_cke_trip(): atom to tape.
|
|
*/
|
|
u2_atom
|
|
u2_cke_trip(u2_noun a)
|
|
{
|
|
u2_atom b = _coal_trip(u2_Wire, a);
|
|
|
|
u2_cz(a);
|
|
return b;
|
|
}
|