/* f/coal.c ** ** This file is in the public domain. */ #include "all.h" #include #include #include #include #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_n_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; }