/* f/loom.c ** ** This file is in the public domain. */ #include "all.h" #include #include #include #include #include #include #include "v/vere.h" /* _loom_stop(): signal handler to stop computation. */ static void _loom_stop(c3_i sig) { } static c3_i _loom_sigsegv_handler(void* adr_v, c3_i ser_i) { if ( ser_i ) { c3_w* bas_w = (c3_w*)(void *)(U2_OS_LoomBase); c3_w off_w = (((c3_c*) adr_v) - (c3_c*)U2_OS_LoomBase) >> 2; c3_w pag_w = off_w >> LoomPageWords; c3_w win_w; u2_cheg* ceg_u; if ( pag_w > LoomAllPages ) { fprintf(stderr, "address %p out of loom!\r\n", adr_v); return 0; } c3_assert((u2_page_neat == LoomChem[pag_w].lif_e) || (u2_page_none == LoomChem[pag_w].lif_e) ); LoomChem[pag_w].lif_e = u2_page_tref; LoomChem[pag_w].mug_e = 0; for ( ceg_u = &LoomSegmentA; ceg_u; ceg_u = ceg_u->nex_u ) { if ( (pag_w >= ceg_u->bot_w) && (win_w=(pag_w - ceg_u->bot_w)) < ceg_u->len_w ) { if ( win_w >= ceg_u->pgs_w ) { ceg_u->pgs_w = win_w + 1; } break; } } if ( 0 == ceg_u ) { fprintf(stderr, "page %d is not in a segment!\n", pag_w); return 1; } if ( -1 == mprotect((void *)(bas_w + (pag_w << LoomPageWords)), (1 << (LoomPageWords + 2)), (PROT_READ | PROT_WRITE)) ) { perror("mprotect"); exit(1); } return 1; } return 0; } /* _loom_read(): full blocking read. */ static u2_bean _loom_read(c3_i fid_i, void* buf_w, c3_w len_w) { return ((4 * len_w) == read(fid_i, buf_w, (4 * len_w))) ? u2_yes : u2_no; } /* _loom_write(): full blocking write. */ static u2_bean _loom_write(c3_i fid_i, void* buf_w, c3_w len_w) { if ((4 * len_w) != write(fid_i, buf_w, (4 * len_w))) { fprintf(stderr, "couldn't write %d\n", fid_i); perror("huh?"); exit(1); } else { fsync(fid_i); // for what it's worth return u2_yes; } // return ((4 * len_w) == write(fid_i, buf_w, (4 * len_w))) ? u2_yes : u2_no; } /* u2_loom_clip(): ** ** Clip top and bottom. */ void u2_loom_clip(c3_w bot_w, c3_w top_w) { } /* _loom_deploy(): load and attempt to validate. */ static u2_bean _loom_deploy(void) { u2_cheg* ceg_u; c3_w num_w = 0; for ( ceg_u = &LoomSegmentA; ceg_u; ceg_u = ceg_u->nex_u ) { u2_chef chf_u; c3_w i_w; /* Load control segment. */ { if ( u2_no == _loom_read(ceg_u->ctl_i, &chf_u, c3_wiseof(chf_u)) ) { printf("deploy no a\n"); return u2_no; } c3_assert(chf_u.bot_w == ceg_u->bot_w); if ( u2_no == _loom_read(ceg_u->ctl_i, (u2_chit*) &LoomChem[ceg_u->bot_w], chf_u.pgs_w) ) { printf("deploy no b\n"); return u2_no; } ceg_u->pgs_w = chf_u.pgs_w; } /* Load data segment. */ { c3_w liv_w = chf_u.pgs_w; c3_w res_w = (ceg_u->len_w - liv_w); c3_w* vil_w = ((c3_w*)U2_OS_LoomBase) + (ceg_u->bot_w << LoomPageWords); c3_w* den_w = (vil_w + (liv_w << LoomPageWords)); if ( liv_w ) { if ( -1 == (c3_ps)mmap(vil_w, (liv_w << (LoomPageWords + 2)), PROT_READ, (MAP_FIXED | MAP_PRIVATE), ceg_u->dat_i, 0) ) { printf("deploy no c\n"); return u2_no; } } if ( res_w ) { if ( -1 == (c3_ps)mmap(den_w, res_w << (LoomPageWords + 2), PROT_READ, (MAP_ANON | MAP_FIXED | MAP_PRIVATE), -1, 0) ) { printf("deploy no d\n"); return u2_no; } } } /* Validate with little checksum. */ for ( i_w = 0; i_w < chf_u.pgs_w; i_w++ ) { c3_w pag_w = (i_w + ceg_u->bot_w); c3_w* gaw_w = ((c3_w*)U2_OS_LoomBase) + (pag_w << LoomPageWords); if ( u2_page_none == LoomChem[pag_w].lif_e ) { continue; } num_w++; if ( u2_page_neat != LoomChem[pag_w].lif_e ) { printf("deploy no e\n"); return u2_no; } if ( (0x3fffffff & u2_mug_words(gaw_w, (1 << LoomPageWords))) != LoomChem[pag_w].mug_e ) { printf("mismatched mug at page %d\n", pag_w); printf("actual data: %x\n", (0x3fffffff & u2_mug_words(gaw_w, (1 << LoomPageWords)))); printf("control mug: %x\n", LoomChem[pag_w].mug_e); printf("deploy no f\n"); return u2_no; } } #if 0 fprintf(stderr, "load: %s bot_w %x, pgs_w %d, num_w %d\n", ceg_u->nam_c, chf_u.bot_w, chf_u.pgs_w, num_w); #endif } printf("loom: loaded %dMB\n", (num_w >> 6)); return u2_yes; } /* u2_loom_save(): checkpoint at current date, with hat and mat. */ u2_bean u2_loom_save(c3_w ent_w) { u2_cheg* ceg_u; c3_w tot_w = 0; // uL(fprintf(uH, "# saving at event %u...\n", ent_w)); u2_wr_check_save(); for ( ceg_u = &LoomSegmentA; ceg_u; ceg_u = ceg_u->nex_u ) { u2_chef chf_u; c3_w i_w; c3_w num_w = 0; chf_u.ent_w = ent_w; chf_u.ven_w = LoomVersion; chf_u.bot_w = ceg_u->bot_w; chf_u.pgs_w = ceg_u->pgs_w; /* Save data. */ { for ( i_w = 0; i_w < ceg_u->pgs_w; i_w++ ) { c3_w pag_w = ceg_u->bot_w + i_w; c3_w* mem_w = ((c3_w*)U2_OS_LoomBase) + (pag_w << LoomPageWords); if ( u2_page_tref == LoomChem[pag_w].lif_e ) { lseek(ceg_u->dat_i, (i_w << (LoomPageWords + 2)), SEEK_SET); if ( u2_no == _loom_write(ceg_u->dat_i, mem_w, (1 << LoomPageWords)) ) { fprintf(stderr, "save no a\r\n"); return u2_no; } LoomChem[pag_w].mug_e = u2_mug_words(mem_w, (1 << LoomPageWords)); LoomChem[pag_w].lif_e = u2_page_neat; num_w++; } } ftruncate(ceg_u->dat_i, (ceg_u->pgs_w << (LoomPageWords + 2))); } #if 0 fprintf(stderr, "save: %s bot_w %x, pgs_w %d, num_w %d\r\n", ceg_u->nam_c, chf_u.bot_w, chf_u.pgs_w, num_w); #endif /* Save control file. */ lseek(ceg_u->ctl_i, 0, SEEK_SET); if ( u2_no == _loom_write(ceg_u->ctl_i, (c3_w*)&chf_u, c3_wiseof(chf_u)) ) { fprintf(stderr, "save no b\r\n"); return u2_no; } if ( u2_no == _loom_write(ceg_u->ctl_i, (u2_chit*)(LoomChem + ceg_u->bot_w), ceg_u->pgs_w) ) { fprintf(stderr, "save no c\r\n"); return u2_no; } /* Catch future changes. */ if ( -1 == mprotect(((c3_w*)U2_OS_LoomBase) + (ceg_u->bot_w << LoomPageWords), (ceg_u->len_w << (LoomPageWords + 2)), PROT_READ) ) { fprintf(stderr, "save no d\r\n"); return u2_no; } for ( i_w = 0; i_w < ceg_u->len_w; i_w++ ) { LoomChem[i_w + ceg_u->bot_w].lif_e = u2_page_neat; } tot_w += num_w; } /* sync the mfer */ for ( ceg_u = &LoomSegmentA; ceg_u; ceg_u = ceg_u->nex_u ) { #if defined(U2_OS_linux) fdatasync(ceg_u->ctl_i); fdatasync(ceg_u->dat_i); #elif defined(U2_OS_osx) fcntl(ceg_u->ctl_i, F_FULLFSYNC); fcntl(ceg_u->dat_i, F_FULLFSYNC); #elif defined(U2_OS_bsd) fsync(ceg_u->ctl_i); fsync(ceg_u->dat_i); #else #error "port: datasync" #endif } #if 0 uL(fprintf(uH, "loom: wrote %uMB\n", (tot_w >> 6))); #endif return u2_yes; } /* _loom_start(): set up interrupts, etc. */ static void _loom_start(void) { if ( 0 != sigsegv_install_handler(_loom_sigsegv_handler) ) { fprintf(stderr, "sigsegv install failed\n"); exit(1); } { struct rlimit rlm; getrlimit(RLIMIT_STACK, &rlm); rlm.rlim_cur = 65536 << 10; setrlimit(RLIMIT_STACK, &rlm); } signal(SIGINT, _loom_stop); } /* u2_loom_load(): ** ** Try to load the loom from a checkpoint. */ u2_bean u2_loom_load(void) { if ( u2_yes == _loom_deploy() ) { _loom_start(); return u2_yes; } else { munmap((c3_w*)U2_OS_LoomBase, (LoomAllPages << (LoomPageWords + 2))); return u2_no; } } /* u2_loom_boot(): ** ** Instantiate the loom. */ void u2_loom_boot(void) { void *map; map = mmap((void *)U2_OS_LoomBase, (HalfSize << 3), PROT_READ, (MAP_ANON | MAP_FIXED | MAP_PRIVATE), -1, 0); if ( -1 == (c3_ps)map ) { map = mmap((void *)0, (HalfSize << 3), PROT_READ, MAP_ANON | MAP_PRIVATE, -1, 0); if ( -1 == (c3_ps)map ) { fprintf(stderr, "map failed twice\n"); } else { fprintf(stderr, "map failed - try U2_OS_LoomBase %p\n", map); } exit(1); } printf("loom: mapped %dMB\n", (1 << (LoomBits - 18))); _loom_start(); } /* u2_mean(): ** ** Attempt to deconstruct `a` by axis, noun pairs; 0 terminates. ** Axes must be sorted in tree order. */ struct _mean_pair { c3_w axe_w; u2_noun* som; }; static c3_w _mean_cut(c3_w len_w, struct _mean_pair* prs_m) { c3_w i_w, cut_t, cut_w; cut_t = c3_false; cut_w = 0; for ( i_w = 0; i_w < len_w; i_w++ ) { c3_w axe_w = prs_m[i_w].axe_w; if ( (cut_t == c3_false) && (3 == u2_ax_cap(axe_w)) ) { cut_t = c3_true; cut_w = i_w; } prs_m[i_w].axe_w = u2_ax_mas(axe_w); } return cut_t ? cut_w : i_w; } static u2_bean _mean_extract(u2_noun som, c3_w len_w, struct _mean_pair* prs_m) { if ( len_w == 0 ) { return u2_yes; } else if ( (len_w == 1) && (1 == prs_m[0].axe_w) ) { *prs_m->som = som; return u2_yes; } else { if ( u2_no == u2_dust(som) ) { return u2_no; } else { c3_w cut_w = _mean_cut(len_w, prs_m); return u2_and (_mean_extract(u2_h(som), cut_w, prs_m), _mean_extract(u2_t(som), (len_w - cut_w), (prs_m + cut_w))); } } } u2_bean u2_mean(u2_noun som, ...) { va_list ap; c3_w len_w; struct _mean_pair* prs_m; c3_assert(u2_none != som); /* Count. */ len_w = 0; { va_start(ap, som); while ( 1 ) { if ( 0 == va_arg(ap, c3_w) ) { break; } va_arg(ap, u2_noun*); len_w++; } va_end(ap); } prs_m = alloca(len_w * sizeof(struct _mean_pair)); /* Install. */ { c3_w i_w; va_start(ap, som); for ( i_w = 0; i_w < len_w; i_w++ ) { prs_m[i_w].axe_w = va_arg(ap, c3_w); prs_m[i_w].som = va_arg(ap, u2_noun*); } va_end(ap); } /* Extract. */ return _mean_extract(som, len_w, prs_m); } /* _frag_word(): fast fragment/branch prediction for top word. */ static u2_weak _frag_word(c3_w a_w, u2_noun b) { c3_assert(0 != a_w); { c3_w dep_w = u2_ax_dep(a_w); while ( dep_w ) { if ( u2_no == u2_dust(b) ) { return u2_none; } else { c3_w x = (1 & (a_w >> (dep_w - 1))); b = *u2_at_ray(1 + x + u2_pom_a(b)); dep_w--; } } return b; } } /* _frag_deep(): fast fragment/branch for deep words. */ static u2_weak _frag_deep(c3_w a_w, u2_noun b) { c3_w dep_w = 32; while ( dep_w ) { if ( u2_no == u2_dust(b) ) { return u2_none; } else { c3_w x = (1 & (a_w >> (dep_w - 1))); b = *u2_at_ray(1 + x + u2_pom_a(b)); dep_w--; } } return b; } /* _frag_phat(): fragment for fat. */ static u2_weak _frag_phat(u2_noun a, u2_noun b) { c3_w len_w = *u2_at_pug_len(a); b = _frag_word(*u2_at_pug_buf(a, (len_w - 1)), b); len_w -= 1; while ( len_w ) { b = _frag_deep(*u2_at_pug_buf(a, (len_w - 1)), b); if ( u2_none == b ) { return b; } else { len_w--; } } return b; } /* u2_frag(): ** ** Return fragment (a) of (b), or u2_none if not applicable. */ u2_weak u2_frag(u2_atom a, u2_noun b) { c3_assert(u2_none != a); c3_assert(u2_none != b); if ( _0 == a ) { return u2_none; } if ( u2_fly_is_cat(a) ) { return _frag_word(a, b); } else { if ( !u2_dog_is_pug(a) ) { return u2_none; } else { return _frag_phat(a, b); #if 0 c3_w fol_w = (u2_met(0, a) - 1); c3_w i_w; mpz_t a_mp; c3_assert(u2_none != b); u2_mp(a_mp, a); for ( i_w=0; i_w < fol_w; i_w++ ) { c3_w lum_w = (fol_w - (i_w + 1)); if ( u2_no == u2_dust(b) ) { mpz_clear(a_mp); return u2_none; } else { if ( (mpz_tstbit(a_mp, lum_w) == 0) ) { b = u2_h(b); } else { b = u2_t(b); } } } mpz_clear(a_mp); return b; #endif } } } /* u2_mug(): ** ** Compute and/or recall the mug (31-bit FNV1a hash) of (a). */ static __inline__ c3_w _mug_fnv(c3_w has_w) { return (has_w * ((c3_w)16777619)); } static __inline__ c3_w _mug_out(c3_w has_w) { return (has_w >> 31) ^ (has_w & 0x7fffffff); } static __inline__ c3_w _mug_both(c3_w lef_w, c3_w rit_w) { c3_w bot_w = _mug_fnv(lef_w ^ _mug_fnv(rit_w)); c3_w out_w = _mug_out(bot_w); if ( 0 != out_w ) { return out_w; } else { return _mug_both(lef_w, ++rit_w); } } c3_w u2_mug_both(c3_w lef_w, c3_w rit_w) { return _mug_both(lef_w, rit_w); } static __inline__ c3_w _mug_bytes_in(c3_w off_w, c3_w nby_w, c3_y* byt_y) { c3_w i_w; for ( i_w = 0; i_w < nby_w; i_w++ ) { off_w = _mug_fnv(off_w ^ byt_y[i_w]); } return off_w; } static c3_w _mug_bytes(c3_w off_w, c3_w nby_w, c3_y* byt_y) { c3_w has_w = _mug_bytes_in(off_w, nby_w, byt_y); c3_w out_w = _mug_out(has_w); if ( 0 != out_w ) { return out_w; } else { return _mug_bytes(++off_w, nby_w, byt_y); } } static __inline__ c3_w _mug_words_in_buf(c3_w off_w, c3_w nwd_w, u2_noun veb) { if ( 0 == nwd_w ) { return off_w; } else { c3_w i_w, x_w; for ( i_w = 0; i_w < (nwd_w - 1); i_w++ ) { x_w = *u2_at_pug_buf(veb, i_w); { c3_y a_y = (x_w & 0xff); c3_y b_y = ((x_w >> 8) & 0xff); c3_y c_y = ((x_w >> 16) & 0xff); c3_y d_y = ((x_w >> 24) & 0xff); off_w = _mug_fnv(off_w ^ a_y); off_w = _mug_fnv(off_w ^ b_y); off_w = _mug_fnv(off_w ^ c_y); off_w = _mug_fnv(off_w ^ d_y); } } x_w = *u2_at_pug_buf(veb, (nwd_w - 1)); if ( x_w ) { off_w = _mug_fnv(off_w ^ (x_w & 0xff)); x_w >>= 8; if ( x_w ) { off_w = _mug_fnv(off_w ^ (x_w & 0xff)); x_w >>= 8; if ( x_w ) { off_w = _mug_fnv(off_w ^ (x_w & 0xff)); x_w >>= 8; if ( x_w ) { off_w = _mug_fnv(off_w ^ (x_w & 0xff)); } } } } } return off_w; } static __inline__ c3_w _mug_words_in(c3_w off_w, c3_w nwd_w, const c3_w* wod_w) { if ( 0 == nwd_w ) { return off_w; } else { c3_w i_w, x_w; for ( i_w = 0; i_w < (nwd_w - 1); i_w++ ) { x_w = wod_w[i_w]; { c3_y a_y = (x_w & 0xff); c3_y b_y = ((x_w >> 8) & 0xff); c3_y c_y = ((x_w >> 16) & 0xff); c3_y d_y = ((x_w >> 24) & 0xff); off_w = _mug_fnv(off_w ^ a_y); off_w = _mug_fnv(off_w ^ b_y); off_w = _mug_fnv(off_w ^ c_y); off_w = _mug_fnv(off_w ^ d_y); } } x_w = wod_w[nwd_w - 1]; if ( x_w ) { off_w = _mug_fnv(off_w ^ (x_w & 0xff)); x_w >>= 8; if ( x_w ) { off_w = _mug_fnv(off_w ^ (x_w & 0xff)); x_w >>= 8; if ( x_w ) { off_w = _mug_fnv(off_w ^ (x_w & 0xff)); x_w >>= 8; if ( x_w ) { off_w = _mug_fnv(off_w ^ (x_w & 0xff)); } } } } } return off_w; } static c3_w _mug_words(c3_w off_w, c3_w nwd_w, const c3_w* wod_w) { c3_w has_w = _mug_words_in(off_w, nwd_w, wod_w); c3_w out_w = _mug_out(has_w); if ( 0 != out_w ) { return out_w; } else { return _mug_words(++off_w, nwd_w, wod_w); } } static c3_w _mug_words_buf(c3_w off_w, c3_w nwd_w, u2_noun veb) { c3_w has_w = _mug_words_in_buf(off_w, nwd_w, veb); c3_w out_w = _mug_out(has_w); if ( 0 != out_w ) { return out_w; } else { return _mug_words_buf(++off_w, nwd_w, veb); } } c3_w u2_mug(u2_noun veb) { c3_assert(u2_none != veb); if ( u2_fly_is_cat(veb) ) { c3_w x_w = veb; return _mug_words(2166136261, (veb ? 1 : 0), &x_w); } else { if ( *u2_at_dog_mug(veb) ) { c3_w mug_w = *u2_at_dog_mug(veb); return mug_w; } else { c3_w mug_w; if ( u2_dog_is_pom(veb) ) { u2_noun hed = *u2_at_pom_hed(veb); u2_noun tel = *u2_at_pom_tel(veb); mug_w = u2_mug_cell(hed, tel); } else { c3_w len_w = *u2_at_pug_len(veb); mug_w = _mug_words_buf(2166136261, len_w, veb); } *u2_at_dog_mug(veb) = mug_w; return mug_w; } } } /* u2_mug_words(): ** ** Compute the mug of `buf`, `len`, LSW first. */ c3_w u2_mug_words(const c3_w *buf_w, c3_w len_w) { return _mug_words(2166136261, len_w, buf_w); } /* u2_mug_string(): ** ** Compute the mug of `a`, LSB first. */ c3_w u2_mug_string(const c3_c *a_c) { return _mug_bytes(2166136261, strlen(a_c), (c3_y *)a_c); } /* u2_mug_cell(): ** ** Compute the mug of the cell `[hed tel]`. */ c3_w u2_mug_cell(u2_noun hed, u2_noun tel) { c3_w lus_w = u2_mug(hed); c3_w biq_w = u2_mug(tel); return u2_mug_both(lus_w, biq_w); } /* u2_mug_trel(): ** ** Compute the mug of `[a b c]`. */ c3_w u2_mug_trel(u2_noun a, u2_noun b, u2_noun c) { return u2_mug_both(u2_mug(a), u2_mug_both(u2_mug(b), u2_mug(c))); } /* u2_mug_qual(): ** ** Compute the mug of `[a b c d]`. */ c3_w u2_mug_qual(u2_noun a, u2_noun b, u2_noun c, u2_noun d) { return u2_mug_both(u2_mug(a), u2_mug_both(u2_mug(b), u2_mug_both(u2_mug(c), u2_mug(d)))); } #ifdef U2_PROFILE c3_w X; // XX not thread-safe c3_w FUN; #endif /* _sing_x(): ** ** Yes iff (a) and (b) are the same noun. */ static u2_bean _sing_x(u2_noun a, u2_noun b) { c3_assert(u2_none != a); c3_assert(u2_none != b); if ( a == b ) { return u2_yes; } else { #ifdef U2_PROFILE X++; #endif if ( u2_fly_is_atom(a) ) { if ( !u2_fly_is_atom(b) || u2_fly_is_cat(a) || u2_fly_is_cat(b) ) { return u2_no; } else { if ( *u2_at_dog_mug(a) && *u2_at_dog_mug(b) && (*u2_at_dog_mug(a) != *u2_at_dog_mug(b)) ) { return u2_no; } else { c3_w w_rez = *u2_at_pug_len(a); c3_w w_mox = *u2_at_pug_len(b); if ( w_rez != w_mox ) { return u2_no; } else { c3_w i_w; for ( i_w = 0; i_w < w_rez; i_w++ ) { if ( (*u2_at_pug_buf(a, i_w)) != (*u2_at_pug_buf(b, i_w)) ) { return u2_no; } } return u2_yes; } } } } else { if ( u2_fly_is_atom(b) ) { return u2_no; } else { if ( *u2_at_dog_mug(a) && *u2_at_dog_mug(b) && (*u2_at_dog_mug(a) != *u2_at_dog_mug(b)) ) { return u2_no; } else { if ( u2_no == _sing_x(u2_h(a), u2_h(b)) ) { return u2_no; } else if ( u2_no == _sing_x(u2_t(a), u2_t(b)) ) { return u2_no; } #if 0 if ( *u2_at_dog_mug(a) && *u2_at_dog_mug(b) ) { fprintf(stderr, "duplicate %x %x\r\n", a, b); } #endif return u2_yes; } } } } } #ifdef U2_PROFILE /* _weight(): count subordinate nouns. */ static c3_w _weight(u2_noun n) { if ( u2_yes == u2_stud(n) ) { return 1; } else { return _weight(u2_h(n)) + _weight(u2_t(n)); } } #endif /* u2_sing(): ** ** Yes iff (a) and (b) are the same noun. */ u2_bean u2_sing(u2_noun a, u2_noun b) { #ifndef U2_PROFILE return _sing_x(a, b); #else X=0; { u2_bean sit = _sing_x(a, b); if ( (u2_yes == sit) && (a != b) ) { u2_tx_did_nod(0, X); } if ( FUN && (X > 10) ) { // printf("mug %x, X %d\n", u2_mug(a), X); // if ( u2_mug(a) == 0xe5c2279 ) // { printf("a %x, b %x\n", a, b); c3_assert(0); } } return sit; } #endif } u2_bean u2_fing(u2_noun a, u2_noun b) { return (a == b) ? u2_yes : u2_no; } /* u2_sing_cell(): ** ** Yes iff `[p q]` and `b` are the same noun. */ u2_bean u2_sing_cell(u2_noun p, u2_noun q, u2_noun b) { return u2_and(u2_dust(b), u2_and(u2_sing(p, u2_h(b)), u2_sing(q, u2_t(b)))); } u2_bean u2_fing_cell(u2_noun p, u2_noun q, u2_noun b) { return u2_and(u2_dust(b), u2_and(u2_fing(p, u2_h(b)), u2_fing(q, u2_t(b)))); } /* u2_sing_mixt(): ** ** Yes iff `[p q]` and `b` are the same noun. */ u2_bean u2_sing_mixt(const c3_c* p_c, u2_noun q, u2_noun b) { return u2_and(u2_dust(b), u2_and(u2_sing_c(p_c, u2_h(b)), u2_sing(q, u2_t(b)))); } u2_bean u2_fing_mixt(const c3_c* p_c, u2_noun q, u2_noun b) { return u2_and(u2_dust(b), u2_and(u2_sing_c(p_c, u2_h(b)), u2_fing(q, u2_t(b)))); } /* u2_sing_trel(): ** ** Yes iff `[p q r]` and `b` are the same noun. */ u2_bean u2_sing_trel(u2_noun p, u2_noun q, u2_noun r, u2_noun b) { return u2_and(u2_dust(b), u2_and(u2_sing(p, u2_h(b)), u2_sing_cell(q, r, u2_t(b)))); } u2_bean u2_fing_trel(u2_noun p, u2_noun q, u2_noun r, u2_noun b) { return u2_and(u2_dust(b), u2_and(u2_fing(p, u2_h(b)), u2_fing_cell(q, r, u2_t(b)))); } /* u2_sing_qual(): ** ** Yes iff `[p q r]` and `b` are the same noun. */ u2_bean u2_sing_qual(u2_noun p, u2_noun q, u2_noun r, u2_noun s, u2_noun b) { return u2_and(u2_dust(b), u2_and(u2_sing(p, u2_h(b)), u2_sing_trel(q, r, s, u2_t(b)))); } u2_bean u2_fing_qual(u2_noun p, u2_noun q, u2_noun r, u2_noun s, u2_noun b) { return u2_and(u2_dust(b), u2_and(u2_fing(p, u2_h(b)), u2_fing_trel(q, r, s, u2_t(b)))); } /* u2_nord(): ** ** Return 0, 1 or 2 if `a` is below, equal to, or above `b`. */ u2_atom u2_nord(u2_noun a, u2_noun b) { c3_assert(u2_none != a); c3_assert(u2_none != b); if ( a == b ) { return _1; } else { if ( u2_fly_is_atom(a) ) { if ( !u2_fly_is_atom(b) ) { return _0; } else { if ( u2_fly_is_cat(a) ) { if ( u2_fly_is_cat(b) ) { return (a < b) ? 0 : 2; } else return 0; } else if ( u2_fly_is_cat(b) ) { return 2; } else { c3_w w_rez = *u2_at_pug_len(a); c3_w w_mox = *u2_at_pug_len(b); if ( w_rez != w_mox ) { return (w_rez < w_mox) ? _0 : _2; } else { c3_w i_w; for ( i_w = 0; i_w < w_rez; i_w++ ) { c3_w ai_w = *u2_at_pug_buf(a, i_w); c3_w bi_w = *u2_at_pug_buf(b, i_w); if ( ai_w != bi_w ) { return (ai_w < bi_w) ? _0 : _2; } } return _1; } } } } else { if ( u2_fly_is_atom(b) ) { return _2; } else { u2_atom c = u2_nord(u2_h(a), u2_h(b)); if ( _1 == c ) { return u2_nord(u2_t(a), u2_t(b)); } else { return c; } } } } } /* u2_sing_c(): ** ** Yes iff (b) is the same noun as the C string a_c. */ u2_bean u2_sing_c(const c3_c* a_c, u2_noun b) { c3_assert(u2_none != b); if ( !u2_fly_is_atom(b) ) { return u2_no; } else { c3_w w_sof = strlen(a_c); c3_w i_w; for ( i_w = 0; i_w < w_sof; i_w++ ) { if ( u2_byte(i_w, b) != a_c[i_w] ) { return u2_no; } } return u2_yes; } } /* u2_as_bush(): ** ** Factor [a] as a bush [b.[p q] c]. */ u2_bean u2_as_bush(u2_noun a, u2_noun* b, u2_noun* c) { c3_assert(u2_none != a); if ( u2_fly_is_atom(a) ) { return u2_no; } else { *b = u2_h(a); if ( u2_fly_is_atom(*b) ) { return u2_no; } else { *c = u2_t(a); return u2_yes; } } } /* u2_as_cell(): ** ** Factor (a) as a cell (b c). */ u2_bean u2_as_cell(u2_noun a, u2_noun* b, u2_noun* c) { c3_assert(u2_none != a); if ( u2_fly_is_atom(a) ) { return u2_no; } else { if ( b ) *b = u2_h(a); if ( c ) *c = u2_t(a); return u2_yes; } } /* u2_as_hext(): ** ** Factor (a) as a hext (b c d e f g) */ u2_bean u2_as_hext(u2_noun a, u2_noun* b, u2_noun* c, u2_noun* d, u2_noun* e, u2_noun* f, u2_noun* g) { u2_noun guf; if ( (u2_yes == u2_as_cell(a, b, &guf)) && (u2_yes == u2_as_quil(guf, c, d, e, f, g)) ) { return u2_yes; } else return u2_no; } /* u2_as_p(): ** ** & [0] if [a] is of the form [b *c]. */ u2_bean u2_as_p(u2_noun a, u2_noun b, u2_noun* c) { u2_noun feg, nux; if ( (u2_yes == u2_as_cell(a, &feg, &nux)) && (u2_yes == u2_sing(feg, b)) ) { *c = nux; return u2_yes; } else return u2_no; } /* u2_as_pq(): ** ** & [0] if [a] is of the form [b *c d]. */ u2_bean u2_as_pq(u2_noun a, u2_noun b, u2_noun* c, u2_noun* d) { u2_noun nux; if ( (u2_yes == u2_as_p(a, b, &nux)) && (u2_yes == u2_as_cell(nux, c, d)) ) { return u2_yes; } else return u2_no; } /* u2_as_pqr(): ** ** & [0] if [a] is of the form [b *c *d *e]. */ u2_bean u2_as_pqr(u2_noun a, u2_noun b, u2_noun* c, u2_noun* d, u2_noun* e) { u2_noun nux; if ( (u2_yes == u2_as_p(a, b, &nux)) && (u2_yes == u2_as_trel(nux, c, d, e)) ) { return u2_yes; } else return u2_no; } /* u2_as_pqrs(): ** ** & [0] if [a] is of the form [b *c *d *e *f]. */ u2_bean u2_as_pqrs(u2_noun a, u2_noun b, u2_noun* c, u2_noun* d, u2_noun* e, u2_noun* f) { u2_noun nux; if ( (u2_yes == u2_as_p(a, b, &nux)) && (u2_yes == u2_as_qual(nux, c, d, e, f)) ) { return u2_yes; } else return u2_no; } /* u2_as_qual(): ** ** Factor (a) as a qual (b c d e). */ u2_bean u2_as_qual(u2_noun a, u2_noun* b, u2_noun* c, u2_noun* d, u2_noun* e) { u2_noun guf; if ( (u2_yes == u2_as_cell(a, b, &guf)) && (u2_yes == u2_as_trel(guf, c, d, e)) ) { return u2_yes; } else return u2_no; } /* u2_as_quil(): ** ** Factor (a) as a quil (b c d e f). */ u2_bean u2_as_quil(u2_noun a, u2_noun* b, u2_noun* c, u2_noun* d, u2_noun* e, u2_noun* f) { u2_noun guf; if ( (u2_yes == u2_as_cell(a, b, &guf)) && (u2_yes == u2_as_qual(guf, c, d, e, f)) ) { return u2_yes; } else return u2_no; } /* u2_as_trel(): ** ** Factor (a) as a trel (b c d). */ u2_bean u2_as_trel(u2_noun a, u2_noun *b, u2_noun *c, u2_noun *d) { u2_noun guf; if ( (u2_yes == u2_as_cell(a, b, &guf)) && (u2_yes == u2_as_cell(guf, c, d)) ) { return u2_yes; } else { return u2_no; } } /* u2_sh(): ** ** Return the head of (a), safely. */ u2_noun u2_sh(u2_cell a) { return (a == u2_none) && (u2_yes == u2_dust(a)) ? a : u2_h(a); } /* u2_st(): ** ** Return the tail of (a), safely. */ u2_noun u2_st(u2_noun a) { return (a == u2_none) && (u2_yes == u2_dust(a)) ? a : u2_t(a); } /* u2_met(): ** ** Return the size of (b) in bits, rounded up to ** (1 << a_y). ** ** For example, (a_y == 3) returns the size in bytes. */ c3_w u2_met(c3_y a_y, u2_atom b) { c3_assert(u2_none != b); c3_assert(u2_fly_is_atom(b)); if ( b == 0 ) { return 0; } else { /* gal_w: number of words besides (daz_w) in (b). ** daz_w: top word in (b). */ c3_w gal_w; c3_w daz_w; if ( u2_fly_is_cat(b) ) { gal_w = 0; daz_w = b; } else { gal_w = (*u2_at_pug_len(b)) - 1; daz_w = (*u2_at_pug_buf(b, gal_w)); } switch ( a_y ) { case 0: case 1: case 2: { /* col_w: number of bits in (daz_w) ** bif_w: number of bits in (b) */ c3_w bif_w, col_w; col_w = c3_bits_word(daz_w); bif_w = col_w + (gal_w << 5); return (bif_w + ((1 << a_y) - 1)) >> a_y; } case 3: { return (gal_w << 2) + ((daz_w >> 24) ? 4 : (daz_w >> 16) ? 3 : (daz_w >> 8) ? 2 : 1); } case 4: { return (gal_w << 1) + ((daz_w >> 16) ? 2 : 1); } default: { c3_y gow_y = (a_y - 5); return ((gal_w + 1) + ((1 << gow_y) - 1)) >> gow_y; } } } } /* u2_bit(): ** ** Return bit (a_w) of (b). */ c3_b u2_bit(c3_w a_w, u2_atom b) { c3_assert(u2_none != b); c3_assert(u2_fly_is_atom(b)); if ( u2_fly_is_cat(b) ) { if ( a_w >= 31 ) { return 0; } else return (1 & (b >> a_w)); } else { c3_y vut_y = (a_w & 31); c3_w pix_w = (a_w >> 5); if ( pix_w >= *u2_at_pug_len(b) ) { return 0; } else { c3_w nys_w = *u2_at_pug_buf(b, pix_w); return (1 & (nys_w >> vut_y)); } } } /* u2_byte(): ** ** Return byte (a_w) of (b). */ c3_y u2_byte(c3_w a_w, u2_atom b) { c3_assert(u2_none != b); c3_assert(u2_fly_is_atom(b)); if ( u2_fly_is_cat(b) ) { if ( a_w > 3 ) { return 0; } else return (255 & (b >> (a_w << 3))); } else { c3_y vut_y = (a_w & 3); c3_w pix_w = (a_w >> 2); if ( pix_w >= *u2_at_pug_len(b) ) { return 0; } else { c3_w nys_w = *u2_at_pug_buf(b, pix_w); return (255 & (nys_w >> (vut_y << 3))); } } } /* u2_bytes(): ** ** Copy bytes (a_w) through (a_w + b_w - 1) from (d) to (c). */ void u2_bytes(c3_w a_w, c3_w b_w, c3_y* c_y, u2_atom d) { c3_w i_w; c3_assert(u2_none != d); /* Efficiency: don't call u2_word(). */ for ( i_w = 0; i_w < b_w; i_w++ ) { c_y[i_w] = u2_byte((a_w + i_w), d); } } /* u2_mp(): ** ** Copy (b) into (a_mp). */ void u2_mp(mpz_t a_mp, u2_atom b) { c3_assert(u2_none != b); c3_assert(u2_fly_is_atom(b)); if ( u2_fly_is_cat(b) ) { mpz_init_set_ui(a_mp, b); } else { c3_w len_w = *u2_at_pug_len(b); /* Slight deficiency in the GMP API. */ c3_assert(!(len_w >> 27)); mpz_init2(a_mp, len_w << 5); /* Efficiency: horrible. */ { c3_w *buf_w = alloca(len_w << 2); c3_w i_w; for ( i_w=0; i_w < len_w; i_w++ ) { buf_w[i_w] = *u2_at_pug_buf(b, i_w); } mpz_import(a_mp, len_w, -1, 4, 0, 0, buf_w); } } } /* u2_word(): ** ** Return word (a_w) of (b). */ c3_w u2_word(c3_w a_w, u2_atom b) { c3_assert(u2_none != b); c3_assert(u2_fly_is_atom(b)); if ( u2_fly_is_cat(b) ) { if ( a_w > 0 ) { return 0; } else return b; } else { if ( a_w >= *u2_at_pug_len(b) ) { return 0; } else return *u2_at_pug_buf(b, a_w); } } /* u2_chub(): ** ** Return double-word (a_w) of (b). */ c3_d u2_chub(c3_w a_w, u2_atom b) { c3_w wlo_w = u2_word(a_w * 2, b); c3_w whi_w = u2_word(1 + (a_w * 2), b); return (((uint64_t)whi_w) << 32ULL) | ((uint64_t)wlo_w); } /* u2_words(): ** ** Copy words (a_w) through (a_w + b_w - 1) from (d) to (c). */ void u2_words(c3_w a_w, c3_w b_w, c3_w* c_w, u2_atom d) { c3_w i_w; c3_assert(u2_none != d); /* Efficiency: don't call u2_word(). */ for ( i_w = 0; i_w < b_w; i_w++ ) { c_w[i_w] = u2_word((a_w + i_w), d); } } /* u2_chop(): ** ** Into the bloq space of `met`, from position `fum` for a ** span of `wid`, to position `tou`, XOR from atom `src` ** into ray `dst`. */ void u2_chop(c3_g met_g, c3_w fum_w, c3_w wid_w, c3_w tou_w, u2_ray dst_r, u2_atom src) { c3_w i_w; c3_assert(u2_none != src); c3_assert(u2_fly_is_atom(src)); if ( met_g < 5 ) { c3_w san_w = (1 << met_g); c3_w mek_w = ((1 << san_w) - 1); c3_w baf_w = (fum_w << met_g); c3_w bat_w = (tou_w << met_g); // XX: efficiency: poor. Iterate by words. // for ( i_w = 0; i_w < wid_w; i_w++ ) { c3_w waf_w = (baf_w >> 5); c3_g raf_g = (baf_w & 31); c3_w wat_w = (bat_w >> 5); c3_g rat_g = (bat_w & 31); c3_w hop_w; hop_w = u2_atom_word(src, waf_w); hop_w = (hop_w >> raf_g) & mek_w; *u2_at_ray(dst_r + wat_w) ^= (hop_w << rat_g); baf_w += san_w; bat_w += san_w; } } else { c3_w len_w = (u2_fly_is_cat(src) ? 1 : *u2_at_pug_len(src)); c3_g hut_g = (met_g - 5); c3_w san_w = (1 << hut_g); c3_w j_w; for ( i_w = 0; i_w < wid_w; i_w++ ) { c3_w wuf_w = (fum_w + i_w) << hut_g; c3_w wut_w = (tou_w + i_w) << hut_g; for ( j_w = 0; j_w < san_w; j_w++ ) { *u2_at_ray(dst_r + wut_w + j_w) ^= ((wuf_w + j_w) >= len_w) ? 0 : u2_atom_word(src, wuf_w + j_w); } } } }