shrub/gen164/6/ut_heal.c

351 lines
9.2 KiB
C
Raw Normal View History

2013-09-29 00:21:18 +04:00
/* j/6/heal.c
**
** This file is in the public domain.
*/
#include "all.h"
#include "../pit.h"
/* internals
*/
static u2_noun
2014-08-21 01:18:34 +04:00
_heal_as(u2_noun, u2_noun, u2_noun, u2_atom, u2_noun);
2013-09-29 00:21:18 +04:00
static u2_noun
2014-08-21 01:18:34 +04:00
_heal_by(
2013-09-29 00:21:18 +04:00
u2_noun van,
u2_noun sut,
u2_noun qog,
2013-09-29 00:21:18 +04:00
u2_noun ref)
{
u2_noun p_sut, q_sut;
2014-08-21 01:18:34 +04:00
if ( u2_no == u2du(sut) ) {
return u2_cm_error("heal-name");
2013-09-29 00:21:18 +04:00
}
2014-08-21 01:18:34 +04:00
else switch ( u2h(sut) ) {
default: return u2_cm_error("heal-name");
2013-09-29 00:21:18 +04:00
case c3__core:
{
2014-08-21 01:18:34 +04:00
return u2k(ref);
2013-09-29 00:21:18 +04:00
}
2014-08-21 01:18:34 +04:00
case c3__bull: u2_cx_cell(u2t(sut), &p_sut, &q_sut);
2013-12-26 21:12:07 +04:00
{
2014-08-21 01:18:34 +04:00
if ( u2_yes == u2_cr_sing(u2h(p_sut), u2t(qog)) ) {
return u2k(ref);
2014-02-11 09:34:24 +04:00
}
else {
2014-08-21 01:18:34 +04:00
u2_noun sub = _heal_by(van, q_sut, qog, ref);
2014-02-11 09:34:24 +04:00
u2_noun ret;
2014-01-04 06:59:56 +04:00
2014-02-11 09:34:24 +04:00
ret = j2_mcy(Pt6, ut, busk)
2014-08-21 01:18:34 +04:00
(van, sub, u2h(p_sut), u2h(u2t(p_sut)));
2014-01-04 06:59:56 +04:00
2014-02-11 09:34:24 +04:00
u2z(sub);
return ret;
}
2013-12-26 21:12:07 +04:00
}
2014-08-21 01:18:34 +04:00
case c3__face: u2_cx_cell(u2t(sut), &p_sut, &q_sut);
2013-09-29 00:21:18 +04:00
{
2014-08-21 01:18:34 +04:00
if ( u2_yes == u2_cr_sing(p_sut, u2t(qog)) ) {
return j2_mby(Pt6, face)(p_sut, ref);
2013-09-29 00:21:18 +04:00
}
2014-08-21 01:18:34 +04:00
else return u2_cm_error("heal-name");
2013-09-29 00:21:18 +04:00
}
case c3__hold: {
2014-08-21 01:18:34 +04:00
u2_noun rep = j2_mcy(Pt6, ut, repo)(van, sut);
u2_noun ret = _heal_by(van, rep, qog, ref);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
u2z(rep);
2013-09-29 00:21:18 +04:00
return ret;
}
2014-08-21 01:18:34 +04:00
case c3__fork: u2_cx_cell(u2t(sut), &p_sut, &q_sut);
2013-09-29 00:21:18 +04:00
{
2014-08-21 01:18:34 +04:00
u2_noun dis = _heal_by(van, p_sut, qog, ref);
u2_noun dat = _heal_by(van, q_sut, qog, ref);
u2_noun ret = j2_mby(Pt6, fork)(dis, dat);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
u2z(dis);
u2z(dat);
2013-09-29 00:21:18 +04:00
return ret;
}
}
}
static u2_noun
2014-08-21 01:18:34 +04:00
_heal_to(
2013-09-29 00:21:18 +04:00
u2_noun van,
u2_noun sut,
u2_noun gil,
u2_noun qog,
u2_noun ref,
u2_atom now,
u2_atom lat)
{
u2_noun p_sut, q_sut;
2014-08-21 01:18:34 +04:00
if ( u2_no == u2du(sut) ) {
2013-09-29 00:21:18 +04:00
goto repo;
}
2014-08-21 01:18:34 +04:00
else switch ( u2h(sut) ) {
2013-09-29 00:21:18 +04:00
default: goto repo;
case c3__atom: return c3__void;
2014-01-04 06:59:56 +04:00
2014-08-21 01:18:34 +04:00
case c3__bull: u2_cx_cell(u2t(sut), &p_sut, &q_sut);
2014-01-04 06:59:56 +04:00
{
2014-08-21 01:18:34 +04:00
u2_noun sub = _heal_to(van, q_sut, gil, qog, ref, now, lat);
2014-01-04 06:59:56 +04:00
u2_noun ret;
ret = j2_mcy(Pt6, ut, busk)
2014-08-21 01:18:34 +04:00
(van, sub, u2h(p_sut), u2h(u2t(p_sut)));
2014-01-04 06:59:56 +04:00
u2z(sub);
return ret;
}
2014-08-21 01:18:34 +04:00
case c3__cell: u2_cx_cell(u2t(sut), &p_sut, &q_sut);
2013-09-29 00:21:18 +04:00
{
u2_noun ter, ret;
2014-08-21 01:18:34 +04:00
if ( 2 == now ) {
ter = _heal_as(van, p_sut, qog, lat, ref);
ret = j2_mby(Pt6, cell)(ter, q_sut);
2013-09-29 00:21:18 +04:00
} else {
2014-08-21 01:18:34 +04:00
ter = _heal_as(van, q_sut, qog, lat, ref);
ret = j2_mby(Pt6, cell)(p_sut, ter);
2013-09-29 00:21:18 +04:00
}
2014-08-21 01:18:34 +04:00
u2z(ter);
2013-09-29 00:21:18 +04:00
return ret;
}
2014-08-21 01:18:34 +04:00
case c3__core: u2_cx_cell(u2t(sut), &p_sut, &q_sut);
2013-09-29 00:21:18 +04:00
{
2014-08-21 01:18:34 +04:00
if ( 3 != now ) {
return u2_cm_error("heal-core");
2013-09-29 00:21:18 +04:00
} else {
2014-08-21 01:18:34 +04:00
u2_noun ter = _heal_as(van, p_sut, qog, lat, ref);
u2_noun ret = j2_mby(Pt6, core)(ter, q_sut);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
u2z(ter);
2013-09-29 00:21:18 +04:00
return ret;
}
}
2014-08-21 01:18:34 +04:00
case c3__face: u2_cx_cell(u2t(sut), &p_sut, &q_sut);
2014-04-03 05:06:45 +04:00
{
2014-08-21 01:18:34 +04:00
u2_noun dun = _heal_to(van, q_sut, gil, qog, ref, now, lat);
u2_noun ret = j2_mby(Pt6, face)(p_sut, dun);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
u2z(dun);
2014-04-03 05:06:45 +04:00
return ret;
}
2014-08-21 01:18:34 +04:00
case c3__fork: u2_cx_cell(u2t(sut), &p_sut, &q_sut);
2013-09-29 00:21:18 +04:00
{
2014-08-21 01:18:34 +04:00
u2_noun dis = _heal_to(van, p_sut, gil, qog, ref, now, lat);
u2_noun dat = _heal_to(van, q_sut, gil, qog, ref, now, lat);
u2_noun ret = j2_mby(Pt6, fork)(dis, dat);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
u2z(dis);
u2z(dat);
2013-09-29 00:21:18 +04:00
return ret;
}
case c3__hold: {
2014-08-21 01:18:34 +04:00
if ( (u2_yes == j2_mcc(Pt4, in, has)(gil, sut)) ) {
2013-09-29 00:21:18 +04:00
return c3__void;
}
2013-09-29 00:21:18 +04:00
else {
2014-08-21 01:18:34 +04:00
u2_noun zoc = j2_mcc(Pt4, in, put)(gil, sut);
u2_noun rep = j2_mcy(Pt6, ut, repo)(van, sut);
u2_noun ret = _heal_to(van, rep, zoc, qog, ref, now, lat);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
u2z(rep);
u2z(zoc);
2013-09-29 00:21:18 +04:00
return ret;
}
}
}
repo: {
2014-08-21 01:18:34 +04:00
u2_noun rep = j2_mcy(Pt6, ut, repo)(van, sut);
u2_noun ret = _heal_to(van, rep, gil, qog, ref, now, lat);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
u2z(rep);
2013-09-29 00:21:18 +04:00
return ret;
}
}
static u2_noun
2014-08-21 01:18:34 +04:00
_heal_as(
2013-09-29 00:21:18 +04:00
u2_noun van,
u2_noun sut,
u2_noun qog,
u2_atom axe,
u2_noun ref)
{
2014-08-21 01:18:34 +04:00
if ( 1 == axe ) {
2013-09-29 00:21:18 +04:00
if ( u2_nul == qog ) {
2014-08-21 01:18:34 +04:00
return u2k(ref);
} else return _heal_by(van, sut, qog, ref);
2013-09-29 00:21:18 +04:00
}
else {
2014-08-21 01:18:34 +04:00
u2_atom now = j2_mbc(Pt3, cap)(axe);
u2_atom lat = j2_mbc(Pt3, mas)(axe);
u2_noun ret = _heal_to(van, sut, u2_nul, qog, ref, now, lat);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
u2z(lat);
2013-09-29 00:21:18 +04:00
return ret;
}
}
2013-09-29 00:21:18 +04:00
/* functions
*/
u2_noun // transfer
2014-08-21 01:18:34 +04:00
j2_mcx(Pt6, ut, heal)(
2013-09-29 00:21:18 +04:00
u2_noun van, // retain
u2_noun sut, // retain
u2_noun qog, // retain
u2_noun axe, // retain
u2_noun ref) // retain
{
2014-08-21 01:18:34 +04:00
return _heal_as(van, sut, qog, axe, ref);
2013-09-29 00:21:18 +04:00
}
/* boilerplate
*/
u2_ho_jet
2013-09-29 00:21:18 +04:00
j2_mcj(Pt6, ut, heal)[];
u2_noun // transfer
2014-08-21 01:18:34 +04:00
j2_mc(Pt6, ut, heal)(
2013-09-29 00:21:18 +04:00
u2_noun cor) // retain
{
u2_noun van, sut, qog, axe, ref;
2014-08-21 01:18:34 +04:00
if ( (u2_no == u2_cr_mean(cor, u2_cv_sam_2, &qog,
2013-09-29 00:21:18 +04:00
u2_cv_sam_6, &axe,
u2_cv_sam_7, &ref,
u2_cv_con, &van,
2013-09-29 00:21:18 +04:00
0)) ||
2014-08-21 01:18:34 +04:00
(u2_no == u2ud(axe)) ||
(u2_none == (sut = u2_cr_at(u2_cv_sam, van))) )
2013-09-29 00:21:18 +04:00
{
2014-08-21 01:18:34 +04:00
return u2_cm_bail(c3__fail);
2013-09-29 00:21:18 +04:00
} else {
2014-08-21 01:18:34 +04:00
return j2_mcx(Pt6, ut, heal)(van, sut, qog, axe, ref);
2013-09-29 00:21:18 +04:00
}
}
u2_weak // transfer
2014-08-21 01:18:34 +04:00
j2_mci(Pt6, ut, heal)(
2013-09-29 00:21:18 +04:00
u2_noun van, // retain
u2_noun sut, // retain
u2_noun qog, // retain
u2_noun axe, // retain
u2_noun ref) // retain
{
2014-08-21 01:24:29 +04:00
u2_weak hoc = u2_cj_look(u2k(van), "heal");
2013-09-29 00:21:18 +04:00
if ( u2_none == hoc ) {
c3_assert(!"register heal");
return u2_none;
} else {
2014-08-21 01:18:34 +04:00
u2_weak von = u2_ci_molt(u2k(van), u2_cv_sam, u2k(sut), 0);
u2_weak gat = u2_cn_nock_on(von, hoc);
u2_weak cor = u2_ci_molt(u2k(gat), u2_cv_sam_2, u2k(qog),
u2_cv_sam_6, u2k(axe),
u2_cv_sam_7, u2k(ref),
2013-09-29 00:21:18 +04:00
0);
if ( (u2_none == j2_mcj(Pt6, ut, heal)[0].xip) ) {
2014-08-21 01:24:29 +04:00
u2_noun xip = u2_cj_find(u2k(cor));
2013-09-29 00:21:18 +04:00
c3_assert(u2_none != xip);
j2_mcj(Pt6, ut, heal)[0].xip = xip;
}
2014-08-21 01:18:34 +04:00
u2z(gat);
2013-09-29 00:21:18 +04:00
return cor;
}
}
u2_noun // transfer
2014-08-21 01:18:34 +04:00
j2_mcy(Pt6, ut, heal)(
2013-09-29 00:21:18 +04:00
u2_noun van, // retain
u2_noun sut, // retain
u2_noun qog, // retain
u2_noun axe, // retain
u2_noun ref) // retain
{
u2_ho_jet *jet_j = &j2_mcj(Pt6, ut, heal)[0];
if ( (jet_j->sat_s & u2_jet_live) && !(jet_j->sat_s & u2_jet_test) ) {
if ( !(jet_j->sat_s & u2_jet_memo) ) {
2014-08-21 01:18:34 +04:00
return j2_mcx(Pt6, ut, heal)(van, sut, qog, axe, ref);
2013-09-29 00:21:18 +04:00
}
else {
c3_m fun_m = c3__heal;
2014-08-21 01:18:34 +04:00
u2_noun pro = u2_ch_find_4(fun_m, sut, qog, axe, ref);
2013-09-29 00:21:18 +04:00
if ( u2_none != pro ) {
return pro;
}
else {
2014-08-21 01:18:34 +04:00
pro = j2_mcx(Pt6, ut, heal)(van, sut, qog, axe, ref);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
return u2_ch_save_4(fun_m, sut, qog, axe, ref, pro);
2013-09-29 00:21:18 +04:00
}
}
}
else {
u2_noun cor, fol, pro;
2014-08-21 01:18:34 +04:00
cor = j2_mci(Pt6, ut, heal)(van, sut, qog, axe, ref);
fol = u2h(cor);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
pro = u2_ho_use(jet_j, cor, fol);
if ( u2_none == pro ) return u2_cm_bail(c3__fail);
2013-09-29 00:21:18 +04:00
2014-08-21 01:18:34 +04:00
u2z(cor);
u2z(fol);
2013-09-29 00:21:18 +04:00
return pro;
}
}
u2_weak
2014-08-21 01:18:34 +04:00
j2_mck(Pt6, ut, heal)(
2013-09-29 00:21:18 +04:00
u2_noun cor)
{
u2_noun sut, qog, axe, ref, van;
2014-08-21 01:18:34 +04:00
if ( (u2_no == u2_cr_mean(cor, u2_cv_sam_2, &qog,
2013-09-29 00:21:18 +04:00
u2_cv_sam_6, &axe,
u2_cv_sam_7, &ref,
u2_cv_con, &van,
2013-09-29 00:21:18 +04:00
0)) ||
2014-08-21 01:18:34 +04:00
(u2_none == (sut = u2_cr_at(u2_cv_sam, van))) )
2013-09-29 00:21:18 +04:00
{
return u2_none;
} else {
2014-08-21 01:18:34 +04:00
return u2nq
(u2k(qog),
u2k(sut),
u2k(axe),
u2k(ref));
2013-09-29 00:21:18 +04:00
}
}
/* structures
*/
u2_ho_jet
2013-09-29 00:21:18 +04:00
j2_mcj(Pt6, ut, heal)[] = {
{ ".2", c3__hevy,
j2_mc(Pt6, ut, heal),
2013-09-29 00:21:18 +04:00
Tier6_b,
u2_none, u2_none,
j2_mck(Pt6, ut, heal), c3__heal,
},
{ }
};