/* _unix_scan(): scan noun from file.
*/
static u2_noun
_unix_scan(u2_wire wir_r,
FILE* fil)
{
c3_i c = fgetc(fil);
if ( c == '[' ) {
return _unix_scan_cell(wir_r, fil);
}
else if ( c == '%' ) {
c3_c buf[1025];
fscanf(fil, "%1024[a-z-]", buf);
return u2_bn_string(wir_r, buf);
}
else {
mpz_t amp;
ungetc(c, fil);
mpz_init(amp);
gmp_fscanf(fil, "%Zd", amp);
return u2_bn_mp(wir_r, amp);
}
}
/* u2_bl_error(): simple string error.
*/
u2_noun
u2_bl_error(u2_wire wir_r,
const c3_c* err_c) // retain
{
u2_bl_push(wir_r, u2_bc(wir_r, c3__lose, u2_bn_string(wir_r, err_c)));
return u2_bl_bail(wir_r, c3__exit);
}
/* _hill_z_make_txt_c(): execute string against shoe, producing shoe.
*/
static u2_noun // produce
_hill_z_make_txt_c(u2_wire wir_r,
u2_noun sho, // retain
const c3_c* txt_c) // retain
{
u2_noun txt = u2_bn_string(wir_r, txt_c);
u2_noun ret = _hill_z_make_txt(wir_r, sho, txt);
u2_rz(wir_r, txt);
return ret;
}
/* _hill_a_make_txt_c(): execute string against shoe, producing shoe.
*/
static hi_shoa // produce
_hill_a_make_txt_c(u2_wire wir_r,
hi_shoz soa, // retain
hi_shoa cor, // retain
const c3_c* txt_c) // retain
{
u2_noun txt = u2_bn_string(wir_r, txt_c);
u2_noun ret = _hill_a_make_txt(wir_r, soa, cor, txt);
u2_rz(wir_r, txt);
return ret;
}
// shep: show with caption and style
//
u2_noun // produce
j2_mcy(Pt6, ut, shep)(u2_wire wir_r,
u2_noun van, // retain
const c3_c* paz_c, // retain
u2_noun sty, // retain
u2_noun mol) // submit
{
return j2_mcy(Pt6, ut, shew)
(wir_r, van,
u2_bc
(wir_r, u2_bc(wir_r, 'c', u2_bn_string(wir_r, paz_c)),
u2_bc(wir_r, u2_rx(wir_r, sty), mol)));
}
/* _hill_b_fire(): execute and print expression over pit C (with shoe B).
*/
static void // produce
_hill_b_fire(u2_wire wir_r,
u2_noun soa, // retain
u2_noun sob, // retain
u2_noun soc, // retain
const c3_c* exp_c, // retain
const c3_c* out_c) // retain
{
u2_noun txt, gam, som;
txt = u2_bn_string(wir_r, exp_c);
gam = _hill_b_mint_txt(wir_r, soa, sob, u2_h(soc), c3__noun, txt);
_hill_b_print_type(wir_r, soa, sob, 0, 0, u2_h(gam));
if ( out_c && !strcmp("p", out_c) ) {
u2_rz(wir_r, txt);
u2_rz(wir_r, gam);
return;
}
u2_bx_boot(wir_r);
som = _hill_nock(wir_r, u2_t(soc), u2_t(gam));
u2_bx_show(wir_r);
if ( u2_none == som ) {
fprintf(stderr, "{none}\n");
}
else {
if ( !out_c ) {
_hill_print_noun(wir_r, 0, 0, som);
} else if ( !strcmp("w", out_c) ) {
_hill_print_wall(wir_r, 0, 0, som);
}
else if ( !strcmp("t", out_c) ) {
_hill_print_tape(wir_r, 0, som); printf("\n");
}
else if ( !strcmp("d", out_c) ) {
_hill_print_delm(wir_r, 0, som); printf("\n");
}
else if ( !strcmp("e", out_c) ) {
_hill_print_term(wir_r, 0, som); printf("\n");
}
else if ( !strcmp("y", out_c) ) {
_hill_print_type(wir_r, 0, 0, som);
}
}
u2_rz(wir_r, txt);
u2_rz(wir_r, gam);
u2_rz(wir_r, som);
}
/* _zuse_from(): expression in pit space.
*/
static u2_noun
_zuse_from(struct zuse_state* fod_f,
const c3_c* exp_c)
{
u2_ray wir_r = fod_f->wir_r;
u2_noun exp, gen, fol, val;
exp = u2_bn_string(wir_r, exp_c);
gen = u2_fj_watt(wir_r, exp);
fol = u2_fj_plow_make(wir_r, fod_f->pyt, gen);
val = u2_bn_nock(wir_r, fod_f->pit, fol);
return val;
}
// dunq: create a dunk core for mean
//
u2_noun // produce
j2_mcy(Pt6, ut, dunq)(u2_wire wir_r,
u2_noun van, // retain
const c3_c* paz_c, // retain
u2_noun typ) // retain
{
u2_noun von = u2_bn_molt(wir_r, van, u2_cv_sam, typ, 0);
u2_noun duq = u2_bn_hook(wir_r, von, "dunk");
u2_noun paz = u2_bn_string(wir_r, paz_c);
u2_noun ret = u2_bn_molt(wir_r, duq, u2_cv_sam, paz, 0);
u2_rz(wir_r, paz);
u2_rz(wir_r, duq);
u2_rz(wir_r, von);
return ret;
}
/* logic
*/
u2_noun // transfer
j2_mcx(Pt6, ut, fink)(u2_wire wir_r,
u2_noun van, // retain
u2_noun sut, // retain
u2_noun dep, // retain
u2_noun way, // retain
u2_noun cog) // retain
{
// u2_noun dun = j2_mcy(Pt6, ut, dunq)(wir_r, van, "type", sut);
u2_noun nuc = (u2_blip == cog)
? j2_mcy(Pt6, ut, shew)
(wir_r, van,
u2_bc
(wir_r, u2_bc(wir_r, 'c', u2_bn_string(wir_r, "find-limb")),
9509))
: j2_mcy(Pt6, ut, shep)
(wir_r, van, "find-limb", 'a', u2_rx(wir_r, cog));
u2_noun pro;
// u2_bl_push(wir_r, u2_bc(wir_r, c3__mean, dun));
u2_bl_push(wir_r, u2_bc(wir_r, c3__mean, nuc));
{
u2_noun hoq = j2_mcy(Pt6, ut, find)(wir_r, van, sut, dep, way, cog);
u2_noun fin = u2_t(hoq);
if ( u2_nul == fin ) {
return u2_bl_error(wir_r, "find-none");
}
else {
pro = u2_rx(wir_r, u2_t(fin));
u2_rl_lose(wir_r, hoq);
}
}
// u2_bl_drop(wir_r);
u2_bl_drop(wir_r);
return pro;
}
/* 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);
}
/* zuse_line(): execute a zuse line, as command and argument.
*/
void
zuse_line(struct zuse_state* fod_f,
const c3_c* cmd_c,
const c3_c* arg_c)
{
u2_ray wir_r = fod_f->wir_r;
u2_ray cap_r = u2_rail_cap_r(wir_r);
LoomStop = 0;
u2_bx_boot(wir_r);
u2_rl_leap(wir_r, c3__rock);
{
u2_ray jub_r = u2_bl_open(wir_r);
if ( u2_bl_set(wir_r) ) {
u2_bl_done(wir_r, jub_r);
}
else {
if ( !strcmp(cmd_c, "test") ) {
// zuse_test(fod_f, "watt/t1-273");
zuse_test3(fod_f, "watt/270", arg_c);
}
else if ( !strcmp(cmd_c, "next") ) {
zuse_next4(fod_f, "watt/270", "watt/269", "watt/268", arg_c);
}
else {
#if 0
u2_noun cmd = u2_bn_string(wir_r, cmd_c);
u2_noun cor = u2_bn_mung(wir_r, fod_f->ryd, cmd);
u2_burp(wir_r, 0, u2_fj_prep_noun(wir_r, cor));
if ( arg_c ) {
u2_noun arg = u2_bn_string(wir_r, arg_c);
u2_noun sam = u2_bn_mung(wir_r, fod_f->ryd, arg);
u2_burp(wir_r, 0, u2_fj_prep_noun(wir_r, sam));
}
#else
u2_noun gat, sam, pro;
/* Construct gate from command.
*/
gat = _zuse_from(fod_f, cmd_c);
/* Construct sample from argument.
*/
sam = _zuse_from(fod_f, arg_c);
/* Construct product.
*/
pro = u2_nk_mung(wir_r, gat, sam);
/* Print, if applicable.
*/
{
if ( u2_none != pro ) {
u2_prep pap = u2_fj_prep_noun(wir_r, pro);
u2_burp(wir_r, 0, pap);
u2_bx_spot(wir_r, u2_nul);
}
}
}
#endif
}
}
u2_nk_show(wir_r, stderr);
u2_rl_fall(wir_r);
u2_rail_cap_r(wir_r) = cap_r;
u2_bx_show(wir_r);
}
/* zuse_next4(): forward iteration from source, still a hack.
*/
void
zuse_next4(struct zuse_state* fod_f,
const char* ken_c, // now 270
const char* nex_c, // now 269
const char* ult_c, // now 268
const char* arg_c) // command-line string
{
u2_wire wir_r = fod_f->wir_r;
u2_noun ken = u2_ux_read(wir_r, ken_c, "watt");
u2_noun nex = u2_ux_read(wir_r, nex_c, "watt");
u2_noun ult = u2_ux_read(wir_r, ult_c, "watt");
u2_noun arg = arg_c ? u2_bn_string(wir_r, arg_c) : u2_none;
if ( u2_none == ken ) {
printf("zuse: %s: no file\n", ken_c);
u2_bl_bail(wir_r);
}
if ( u2_none == nex ) {
printf("zuse: %s: no file\n", nex_c);
u2_bl_bail(wir_r);
}
if ( u2_none == ult ) {
printf("zuse: %s: no file\n", ult_c);
u2_bl_bail(wir_r);
}
{
u2_noun gen = j2_mbc(watt_271, ream)(wir_r, ken);
u2_noun xen = j2_mbc(watt_270, ream)(wir_r, nex);
u2_noun las = j2_mbc(watt_269, ream)(wir_r, ult);
u2_noun gar = (arg_c ? j2_mbc(watt_269, ream)(wir_r, arg) : u2_none);
/* Boot sequence!
*/
{
u2_noun sho, hos, osh;
fprintf(stderr, "{boot: %s}\n", ken_c);
sho = zuse_boot_gene(wir_r, fod_f->bot, gen);
if ( u2_none == sho ) {
return;
}
fprintf(stderr, "{boot: %s}\n", nex_c);
hos = zuse_boot_gene(wir_r, sho, xen);
if ( u2_none == hos ) {
return;
}
fprintf(stderr, "{boot: %s}\n", ult_c);
osh = zuse_boot_gene(wir_r, hos, las);
if ( u2_none == osh ) {
return;
}
if ( u2_none != gar ) {
// fprintf(stderr, "{fire: %s}\n", ken_c);
// zuse_fire_gene(wir_r, fod_f->bot, sho, gar);
// fprintf(stderr, "{fire: %s}\n", nex_c);
// zuse_fire_gene(wir_r, sho, hos, gar);
fprintf(stderr, "{fire: %s}\n", ult_c);
zuse_fire_gene(wir_r, hos, osh, gar);
}
u2_rz(wir_r, sho);
u2_rz(wir_r, hos);
u2_rz(wir_r, osh);
}
}
}