mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-11-28 03:00:15 +03:00
Merge branch 'dish' of https://github.com/urbit/urbit into dish
This commit is contained in:
Philip C Monk
commit
b605f9f2b4
394
Makefile
394
Makefile
@ -34,9 +34,10 @@ RM=rm -f
|
||||
CC=gcc
|
||||
CXX=g++
|
||||
CXXFLAGS=$(CFLAGS)
|
||||
CLD=g++ -O2 -g -L/usr/local/lib -L/opt/local/lib
|
||||
CLD=g++ -g -L/usr/local/lib -L/opt/local/lib
|
||||
|
||||
ifeq ($(OS),osx)
|
||||
COSFLAGS=-fno-diagnostics-fixit-info
|
||||
CLDOSFLAGS=-bind_at_load
|
||||
OSLIBS=-framework CoreServices -framework CoreFoundation
|
||||
endif
|
||||
@ -57,8 +58,8 @@ endif
|
||||
INCLUDE=include
|
||||
MDEFINES=-DU2_OS_$(OS) -DU2_OS_ENDIAN_$(ENDIAN) -D U2_LIB=\"$(LIB)\"
|
||||
|
||||
# NOTFORCHECKIN - restore -O2
|
||||
CFLAGS= -O2 -g -msse3 -ffast-math \
|
||||
# NOTFORCHECKIN - restore -O3
|
||||
CFLAGS= $(COSFLAGS) -O3 -msse3 -ffast-math \
|
||||
-funsigned-char \
|
||||
-I/usr/local/include \
|
||||
-I/opt/local/include \
|
||||
@ -77,195 +78,175 @@ CWFLAGS=-Wall
|
||||
.c.o:
|
||||
$(CC) -c $(CWFLAGS) $(CFLAGS) -o $@ $<
|
||||
|
||||
F_OFILES=\
|
||||
f/rail.o \
|
||||
f/meme.o \
|
||||
f/loom.o \
|
||||
f/wire.o \
|
||||
f/chad.o \
|
||||
f/cash.o \
|
||||
f/nash.o \
|
||||
f/coal.o \
|
||||
f/hevn.o \
|
||||
f/host.o \
|
||||
f/benx.o \
|
||||
f/trac.o \
|
||||
f/bail.o \
|
||||
f/dash.o \
|
||||
f/unix.o \
|
||||
f/nock.o
|
||||
G_OFILES=\
|
||||
g/a.o \
|
||||
g/e.o \
|
||||
g/h.o \
|
||||
g/i.o \
|
||||
g/j.o \
|
||||
g/m.o \
|
||||
g/n.o \
|
||||
g/r.o \
|
||||
g/t.o \
|
||||
g/x.o \
|
||||
g/v.o \
|
||||
g/z.o
|
||||
|
||||
J164_1_OFILES=\
|
||||
gen164/1/add.o \
|
||||
gen164/1/dec.o \
|
||||
gen164/1/div.o \
|
||||
gen164/1/gte.o \
|
||||
gen164/1/gth.o \
|
||||
gen164/1/lte.o \
|
||||
gen164/1/lth.o \
|
||||
gen164/1/mod.o \
|
||||
gen164/1/mul.o \
|
||||
gen164/1/sub.o
|
||||
J_1_OFILES=\
|
||||
j/1/add.o \
|
||||
j/1/dec.o \
|
||||
j/1/div.o \
|
||||
j/1/gte.o \
|
||||
j/1/gth.o \
|
||||
j/1/lte.o \
|
||||
j/1/lth.o \
|
||||
j/1/mod.o \
|
||||
j/1/mul.o \
|
||||
j/1/sub.o
|
||||
|
||||
J164_2_OFILES=\
|
||||
gen164/2/bind.o \
|
||||
gen164/2/clap.o \
|
||||
gen164/2/drop.o \
|
||||
gen164/2/flop.o \
|
||||
gen164/2/lent.o \
|
||||
gen164/2/levy.o \
|
||||
gen164/2/lien.o \
|
||||
gen164/2/need.o \
|
||||
gen164/2/reel.o \
|
||||
gen164/2/roll.o \
|
||||
gen164/2/skim.o \
|
||||
gen164/2/skip.o \
|
||||
gen164/2/scag.o \
|
||||
gen164/2/slag.o \
|
||||
gen164/2/snag.o \
|
||||
gen164/2/sort.o \
|
||||
gen164/2/turn.o \
|
||||
gen164/2/weld.o
|
||||
J_2_OFILES=\
|
||||
j/2/bind.o \
|
||||
j/2/clap.o \
|
||||
j/2/drop.o \
|
||||
j/2/flop.o \
|
||||
j/2/lent.o \
|
||||
j/2/levy.o \
|
||||
j/2/lien.o \
|
||||
j/2/need.o \
|
||||
j/2/reel.o \
|
||||
j/2/roll.o \
|
||||
j/2/skim.o \
|
||||
j/2/skip.o \
|
||||
j/2/scag.o \
|
||||
j/2/slag.o \
|
||||
j/2/snag.o \
|
||||
j/2/sort.o \
|
||||
j/2/turn.o \
|
||||
j/2/weld.o
|
||||
|
||||
J164_3_OFILES=\
|
||||
gen164/3/bex.o \
|
||||
gen164/3/can.o \
|
||||
gen164/3/cap.o \
|
||||
gen164/3/cat.o \
|
||||
gen164/3/con.o \
|
||||
gen164/3/cut.o \
|
||||
gen164/3/dor.o \
|
||||
gen164/3/dis.o \
|
||||
gen164/3/end.o \
|
||||
gen164/3/gor.o \
|
||||
gen164/3/hor.o \
|
||||
gen164/3/lsh.o \
|
||||
gen164/3/mas.o \
|
||||
gen164/3/met.o \
|
||||
gen164/3/mix.o \
|
||||
gen164/3/mug.o \
|
||||
gen164/3/mur.o \
|
||||
gen164/3/peg.o \
|
||||
gen164/3/po.o \
|
||||
gen164/3/rap.o \
|
||||
gen164/3/rip.o \
|
||||
gen164/3/rsh.o \
|
||||
gen164/3/vor.o
|
||||
J_3_OFILES=\
|
||||
j/3/bex.o \
|
||||
j/3/can.o \
|
||||
j/3/cap.o \
|
||||
j/3/cat.o \
|
||||
j/3/con.o \
|
||||
j/3/cut.o \
|
||||
j/3/dor.o \
|
||||
j/3/dis.o \
|
||||
j/3/end.o \
|
||||
j/3/gor.o \
|
||||
j/3/hor.o \
|
||||
j/3/lsh.o \
|
||||
j/3/mas.o \
|
||||
j/3/met.o \
|
||||
j/3/mix.o \
|
||||
j/3/mug.o \
|
||||
j/3/peg.o \
|
||||
j/3/po.o \
|
||||
j/3/rap.o \
|
||||
j/3/rip.o \
|
||||
j/3/rsh.o \
|
||||
j/3/vor.o
|
||||
|
||||
J164_4_OFILES=\
|
||||
gen164/4/in.o \
|
||||
gen164/4/by.o \
|
||||
gen164/4/in_has.o \
|
||||
gen164/4/in_int.o \
|
||||
gen164/4/in_gas.o \
|
||||
gen164/4/in_mer.o \
|
||||
gen164/4/in_put.o \
|
||||
gen164/4/in_tap.o \
|
||||
gen164/4/in_uni.o \
|
||||
gen164/4/by_gas.o \
|
||||
gen164/4/by_get.o \
|
||||
gen164/4/by_has.o \
|
||||
gen164/4/by_int.o \
|
||||
gen164/4/by_put.o \
|
||||
gen164/4/by_uni.o
|
||||
J_4_OFILES=\
|
||||
j/4/in_has.o \
|
||||
j/4/in_int.o \
|
||||
j/4/in_gas.o \
|
||||
j/4/in_mer.o \
|
||||
j/4/in_put.o \
|
||||
j/4/in_tap.o \
|
||||
j/4/in_uni.o \
|
||||
j/4/by_gas.o \
|
||||
j/4/by_get.o \
|
||||
j/4/by_has.o \
|
||||
j/4/by_int.o \
|
||||
j/4/by_put.o \
|
||||
j/4/by_uni.o
|
||||
|
||||
J164_5_OFILES=\
|
||||
gen164/5/aesc.o \
|
||||
gen164/5/co.o \
|
||||
gen164/5/cue.o \
|
||||
gen164/5/ed.o \
|
||||
gen164/5/jam.o \
|
||||
gen164/5/mat.o \
|
||||
gen164/5/mink.o \
|
||||
gen164/5/mule.o \
|
||||
gen164/5/parse.o \
|
||||
gen164/5/rd.o \
|
||||
gen164/5/repg.o \
|
||||
gen164/5/rexp.o \
|
||||
gen164/5/rub.o \
|
||||
gen164/5/shax.o \
|
||||
gen164/5/lore.o \
|
||||
gen164/5/loss.o \
|
||||
gen164/5/tape.o \
|
||||
gen164/5/trip.o
|
||||
J_5_OFILES=\
|
||||
j/5/aesc.o \
|
||||
j/5/cue.o \
|
||||
j/5/jam.o \
|
||||
j/5/mat.o \
|
||||
j/5/mink.o \
|
||||
j/5/mule.o \
|
||||
j/5/parse.o \
|
||||
j/5/rd.o \
|
||||
j/5/repg.o \
|
||||
j/5/rexp.o \
|
||||
j/5/rub.o \
|
||||
j/5/shax.o \
|
||||
j/5/lore.o \
|
||||
j/5/loss.o \
|
||||
j/5/trip.o
|
||||
|
||||
J164_5_OFILES_CO=\
|
||||
gen164/5/co_emco.o \
|
||||
gen164/5/co_oxco.o \
|
||||
gen164/5/co_roco.o
|
||||
J_5_OFILES_ED=\
|
||||
j/5/ed_puck.o \
|
||||
j/5/ed_sign.o \
|
||||
j/5/ed_veri.o
|
||||
|
||||
J164_5_OFILES_ED=\
|
||||
gen164/5/ed_puck.o \
|
||||
gen164/5/ed_sign.o \
|
||||
gen164/5/ed_veri.o
|
||||
J_6_OFILES=\
|
||||
j/6/al.o \
|
||||
j/6/ap.o \
|
||||
j/6/bull.o \
|
||||
j/6/cell.o \
|
||||
j/6/comb.o \
|
||||
j/6/cons.o \
|
||||
j/6/core.o \
|
||||
j/6/cube.o \
|
||||
j/6/face.o \
|
||||
j/6/fitz.o \
|
||||
j/6/flan.o \
|
||||
j/6/flay.o \
|
||||
j/6/flip.o \
|
||||
j/6/flor.o \
|
||||
j/6/fork.o \
|
||||
j/6/hike.o \
|
||||
j/6/look.o \
|
||||
|
||||
J164_6_OFILES=\
|
||||
gen164/6/al.o \
|
||||
gen164/6/ap.o \
|
||||
gen164/6/bull.o \
|
||||
gen164/6/cell.o \
|
||||
gen164/6/comb.o \
|
||||
gen164/6/cons.o \
|
||||
gen164/6/core.o \
|
||||
gen164/6/cube.o \
|
||||
gen164/6/face.o \
|
||||
gen164/6/fitz.o \
|
||||
gen164/6/flan.o \
|
||||
gen164/6/flay.o \
|
||||
gen164/6/flip.o \
|
||||
gen164/6/flor.o \
|
||||
gen164/6/fork.o \
|
||||
gen164/6/hike.o \
|
||||
gen164/6/look.o \
|
||||
gen164/6/ut.o
|
||||
J_6_OFILES_UT=\
|
||||
j/6/ut.o \
|
||||
j/6/ut_burn.o \
|
||||
j/6/ut_busk.o \
|
||||
j/6/ut_bust.o \
|
||||
j/6/ut_conk.o \
|
||||
j/6/ut_crop.o \
|
||||
j/6/ut_cull.o \
|
||||
j/6/ut_find.o \
|
||||
j/6/ut_fink.o \
|
||||
j/6/ut_fire.o \
|
||||
j/6/ut_firm.o \
|
||||
j/6/ut_fish.o \
|
||||
j/6/ut_fuse.o \
|
||||
j/6/ut_gain.o \
|
||||
j/6/ut_heal.o \
|
||||
j/6/ut_lose.o \
|
||||
j/6/ut_mint.o \
|
||||
j/6/ut_mull.o \
|
||||
j/6/ut_nest.o \
|
||||
j/6/ut_park.o \
|
||||
j/6/ut_peek.o \
|
||||
j/6/ut_play.o \
|
||||
j/6/ut_repo.o \
|
||||
j/6/ut_rest.o \
|
||||
j/6/ut_seek.o \
|
||||
j/6/ut_swab.o \
|
||||
j/6/ut_tack.o \
|
||||
j/6/ut_tock.o \
|
||||
j/6/ut_wrap.o
|
||||
|
||||
J164_6_OFILES_UT=\
|
||||
gen164/6/ut_burn.o \
|
||||
gen164/6/ut_busk.o \
|
||||
gen164/6/ut_bust.o \
|
||||
gen164/6/ut_conk.o \
|
||||
gen164/6/ut_crop.o \
|
||||
gen164/6/ut_cull.o \
|
||||
gen164/6/ut_find.o \
|
||||
gen164/6/ut_fink.o \
|
||||
gen164/6/ut_fire.o \
|
||||
gen164/6/ut_firm.o \
|
||||
gen164/6/ut_fish.o \
|
||||
gen164/6/ut_fuse.o \
|
||||
gen164/6/ut_gain.o \
|
||||
gen164/6/ut_heal.o \
|
||||
gen164/6/ut_lose.o \
|
||||
gen164/6/ut_mint.o \
|
||||
gen164/6/ut_moot.o \
|
||||
gen164/6/ut_mull.o \
|
||||
gen164/6/ut_nest.o \
|
||||
gen164/6/ut_park.o \
|
||||
gen164/6/ut_peek.o \
|
||||
gen164/6/ut_play.o \
|
||||
gen164/6/ut_repo.o \
|
||||
gen164/6/ut_rest.o \
|
||||
gen164/6/ut_seek.o \
|
||||
gen164/6/ut_sift.o \
|
||||
gen164/6/ut_swab.o \
|
||||
gen164/6/ut_tack.o \
|
||||
gen164/6/ut_tock.o \
|
||||
gen164/6/ut_wrap.o
|
||||
J_OFILES=\
|
||||
$(J_1_OFILES) \
|
||||
$(J_2_OFILES) \
|
||||
$(J_3_OFILES) \
|
||||
$(J_4_OFILES) \
|
||||
$(J_5_OFILES) \
|
||||
$(J_5_OFILES_ED) \
|
||||
$(J_6_OFILES) \
|
||||
$(J_6_OFILES_UT) \
|
||||
j/dash.o
|
||||
|
||||
J164_OFILES=\
|
||||
$(J164_1_OFILES) \
|
||||
$(J164_2_OFILES) \
|
||||
$(J164_3_OFILES) \
|
||||
$(J164_4_OFILES) \
|
||||
$(J164_5_OFILES) \
|
||||
$(J164_5_OFILES_CO) \
|
||||
$(J164_5_OFILES_ED) \
|
||||
$(J164_6_OFILES) \
|
||||
$(J164_6_OFILES_UT) \
|
||||
gen164/watt.o
|
||||
|
||||
BASE_OFILES=\
|
||||
$(F_OFILES) \
|
||||
$(J164_OFILES)
|
||||
BASE_OFILES=$(G_OFILES) $(J_OFILES)
|
||||
|
||||
CRE2_OFILES=\
|
||||
outside/cre2/src/src/cre2.o
|
||||
@ -280,33 +261,46 @@ V_OFILES=\
|
||||
v/loop.o \
|
||||
v/raft.o \
|
||||
v/reck.o \
|
||||
v/save.o \
|
||||
v/sist.o \
|
||||
v/temp.o \
|
||||
v/term.o \
|
||||
v/time.o \
|
||||
v/unix.o \
|
||||
v/save.o \
|
||||
v/walk.o
|
||||
|
||||
MAIN_FILE =\
|
||||
v/main.o
|
||||
|
||||
MEME_FILE =\
|
||||
w/test.o
|
||||
|
||||
VERE_OFILES=\
|
||||
$(BASE_OFILES) \
|
||||
$(CRE2_OFILES) \
|
||||
$(OUT_OFILES) \
|
||||
$(V_OFILES) \
|
||||
$(MAIN_FILE)
|
||||
$(BASE_OFILES) \
|
||||
$(MAIN_FILE) \
|
||||
$(V_OFILES)
|
||||
|
||||
MEME_OFILES=\
|
||||
$(CRE2_OFILES) \
|
||||
$(OUT_OFILES) \
|
||||
$(BASE_OFILES) \
|
||||
$(MEME_FILE)
|
||||
|
||||
# This is a silly hack necessitated by the fact that libuv uses configure
|
||||
#
|
||||
# * Making 'all' obviously requires outside/libuv, which requires the libuv Makefile to be created.
|
||||
# * Making 'all' obviously requires outside/libuv,
|
||||
# which requires the libuv Makefile to be created.
|
||||
# * Making distclean on outside/libuv destroys the makefile.
|
||||
# * ...so configuring outside/libuv is parodoxically required in order to distclean it!
|
||||
# * ...so configuring outside/libuv is parodoxically required
|
||||
# in order to distclean it!
|
||||
# * But what if developer types 'make distclean all' ?
|
||||
# * first target makes libuv Makefile, then destroys it...and second target knows that it was made.
|
||||
# * first target makes libuv Makefile, then destroys it...and
|
||||
# second target knows that it was made.
|
||||
# * ...so second target borks.
|
||||
# * Solution: make libuv not only depend on its own Makefile, but on a side effect of creating its own makefile.
|
||||
# * Solution: make libuv not only depend on its own Makefile,
|
||||
# but on a side effect of creating its own makefile.
|
||||
#
|
||||
LIBUV_MAKEFILE=outside/libuv_0.11/Makefile
|
||||
LIBUV_MAKEFILE2=outside/libuv_0.11/config.log
|
||||
@ -319,12 +313,10 @@ LIBED25519=outside/ed25519/ed25519.a
|
||||
|
||||
LIBANACHRONISM=outside/anachronism/build/libanachronism.a
|
||||
|
||||
BPT_O=outside/bpt/bitmapped_patricia_tree.o
|
||||
all: vere
|
||||
|
||||
vere: $(BIN)/vere
|
||||
|
||||
all: vere
|
||||
|
||||
meme: $(BIN)/meme
|
||||
|
||||
$(LIBUV_MAKEFILE) $(LIBUV_MAKEFILE2):
|
||||
cd outside/libuv_0.11 ; sh autogen.sh ; ./configure --disable-dtrace
|
||||
@ -341,17 +333,18 @@ $(LIBED25519):
|
||||
$(LIBANACHRONISM):
|
||||
$(MAKE) -C outside/anachronism static
|
||||
|
||||
$(BPT_O): outside/bpt/bitmapped_patricia_tree.c
|
||||
$(CC) -g -O2 -o $@ -c $<
|
||||
|
||||
$(CRE2_OFILES): outside/cre2/src/src/cre2.cpp outside/cre2/src/src/cre2.h $(LIBRE2)
|
||||
$(CXX) $(CXXFLAGS) -c $< $(LIBRE2) -o $@
|
||||
|
||||
$(V_OFILES) f/loom.o f/trac.o: include/v/vere.h
|
||||
$(V_OFILES): include/v/vere.h
|
||||
|
||||
$(BIN)/vere: $(LIBCRE) $(VERE_OFILES) $(LIBUV) $(LIBRE2) $(LIBED25519) $(BPT_O) $(LIBANACHRONISM)
|
||||
$(BIN)/vere: $(LIBCRE) $(VERE_OFILES) $(LIBUV) $(LIBRE2) $(LIBED25519) $(LIBANACHRONISM)
|
||||
mkdir -p $(BIN)
|
||||
$(CLD) $(CLDOSFLAGS) -o $(BIN)/vere $(VERE_OFILES) $(LIBUV) $(LIBCRE) $(LIBRE2) $(LIBED25519) $(BPT_O) $(LIBANACHRONISM) $(LIBS)
|
||||
$(CLD) $(CLDOSFLAGS) -o $(BIN)/vere $(VERE_OFILES) $(LIBUV) $(LIBCRE) $(LIBRE2) $(LIBED25519) $(LIBANACHRONISM) $(LIBS)
|
||||
|
||||
$(BIN)/meme: $(LIBCRE) $(MEME_OFILES) $(LIBUV) $(LIBRE2) $(LIBED25519) $(LIBANACHRONISM)
|
||||
mkdir -p $(BIN)
|
||||
$(CLD) $(CLDOSFLAGS) -o $(BIN)/meme $(MEME_OFILES) $(LIBUV) $(LIBCRE) $(LIBRE2) $(LIBED25519) $(LIBANACHRONISM) $(LIBS)
|
||||
|
||||
tags:
|
||||
ctags -R -f .tags --exclude=root
|
||||
@ -386,6 +379,5 @@ distclean: clean $(LIBUV_MAKEFILE)
|
||||
$(MAKE) -C outside/re2 clean
|
||||
$(MAKE) -C outside/ed25519 clean
|
||||
$(MAKE) -C outside/anachronism clean
|
||||
$(RM) $(BPT_O)
|
||||
|
||||
.PHONY: clean debbuild debinstalldistclean etags osxpackage tags
|
||||
|
||||
912
f/bail.c
912
f/bail.c
@ -1,912 +0,0 @@
|
||||
/* f/bail.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* u2_bl_bail(): bail out.
|
||||
**
|
||||
** Bail codes:
|
||||
**
|
||||
** c3__exit for normal exit with correct trace
|
||||
** c3__fail for abnormal failure without assumptions
|
||||
**
|
||||
** When in doubt, fail.
|
||||
**
|
||||
** In both cases, a gc is necessary to clean up leaks.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bl_bail(u2_wire wir_r,
|
||||
c3_l how_l)
|
||||
{
|
||||
return u2_cm_bail(how_l);
|
||||
}
|
||||
|
||||
/* u2_bl_push(): push on meaning stack.
|
||||
*/
|
||||
void
|
||||
u2_bl_push(u2_wire wir_r,
|
||||
u2_noun mon) // transfer
|
||||
{
|
||||
u2_noun tax = u2_rc(wir_r, mon, u2_rx(wir_r, u2_wire_tax(wir_r)));
|
||||
|
||||
if ( u2_none != tax ) {
|
||||
u2_rz(wir_r, u2_wire_tax(wir_r));
|
||||
u2_wire_tax(wir_r) = tax;
|
||||
}
|
||||
else u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
|
||||
/* u2_bl_mean(): push `[%mean roc]` on trace stack.
|
||||
*/
|
||||
void
|
||||
u2_bl_mean(u2_wire wir_r,
|
||||
u2_noun roc) // transfer
|
||||
{
|
||||
return u2_bl_push(wir_r, u2_bc(wir_r, c3__mean, roc));
|
||||
}
|
||||
|
||||
/* u2_bl_drop(): drop from meaning stack.
|
||||
*/
|
||||
void
|
||||
u2_bl_drop(u2_wire wir_r)
|
||||
{
|
||||
u2_noun tax = u2_wire_tax(wir_r);
|
||||
|
||||
c3_assert(u2_yes == u2_dust(tax));
|
||||
|
||||
u2_wire_tax(wir_r) = u2_rx(wir_r, u2_t(tax));
|
||||
u2_rz(wir_r, tax);
|
||||
}
|
||||
|
||||
/* 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);
|
||||
}
|
||||
|
||||
/* u2_bl_some(): test for zero ray.
|
||||
*/
|
||||
u2_ray
|
||||
u2_bl_some(u2_wire wir_r,
|
||||
u2_ray ray_r)
|
||||
{
|
||||
if ( 0 == ray_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else return ray_r;
|
||||
}
|
||||
|
||||
/* u2_bl_good(): test for u2_none.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bl_good(u2_ray wir_r,
|
||||
u2_weak som)
|
||||
{
|
||||
if ( u2_none == som ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else return som;
|
||||
}
|
||||
|
||||
/* u2_bl_flat(): test for atom.
|
||||
*/
|
||||
u2_atom
|
||||
u2_bl_flat(u2_ray wir_r,
|
||||
u2_weak som)
|
||||
{
|
||||
if ( u2_none == som ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else return som;
|
||||
}
|
||||
|
||||
/* u2_bi_h():
|
||||
**
|
||||
** Return the head of (a).
|
||||
*/
|
||||
u2_noun
|
||||
u2_bi_h(u2_ray wir_r,
|
||||
u2_noun a)
|
||||
{
|
||||
if ( u2_no == u2_dust(a) ) return u2_bl_bail(wir_r, c3__exit);
|
||||
|
||||
return u2_h(a);
|
||||
}
|
||||
|
||||
/* u2_bi_t():
|
||||
**
|
||||
** Return the tail of (a).
|
||||
*/
|
||||
u2_noun
|
||||
u2_bi_t(u2_ray wir_r,
|
||||
u2_noun a)
|
||||
{
|
||||
if ( u2_no == u2_dust(a) ) return u2_bl_bail(wir_r, c3__exit);
|
||||
|
||||
return u2_t(a);
|
||||
}
|
||||
|
||||
/* u2_bi_frag():
|
||||
**
|
||||
** Return fragment (a) of (b).
|
||||
*/
|
||||
u2_noun
|
||||
u2_bi_frag(u2_ray wir_r,
|
||||
u2_atom a,
|
||||
u2_noun b)
|
||||
{
|
||||
u2_weak c = u2_frag(a, b);
|
||||
|
||||
if ( u2_none == c ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else return c;
|
||||
}
|
||||
|
||||
/* u2_bi_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_bi_met(u2_ray wir_r,
|
||||
c3_y a_y,
|
||||
u2_noun b)
|
||||
{
|
||||
if ( u2_no == u2_stud(b) ) return u2_bl_bail(wir_r, c3__exit);
|
||||
|
||||
return u2_met(a_y, b);
|
||||
}
|
||||
|
||||
/* u2_bi_bit():
|
||||
**
|
||||
** Return bit (a_w) of (b).
|
||||
*/
|
||||
c3_b
|
||||
u2_bi_bit(u2_ray wir_r,
|
||||
c3_w a_w,
|
||||
u2_noun b)
|
||||
{
|
||||
if ( u2_no == u2_stud(b) ) return u2_bl_bail(wir_r, c3__exit);
|
||||
|
||||
return u2_bit(a_w, b);
|
||||
}
|
||||
|
||||
/* u2_bi_byte():
|
||||
**
|
||||
** Return byte (a_w) of (b).
|
||||
*/
|
||||
c3_y
|
||||
u2_bi_byte(u2_ray wir_r,
|
||||
c3_w a_w,
|
||||
u2_noun b)
|
||||
{
|
||||
if ( u2_no == u2_stud(b) ) return u2_bl_bail(wir_r, c3__exit);
|
||||
|
||||
return u2_byte(a_w, b);
|
||||
}
|
||||
|
||||
/* u2_bi_bytes():
|
||||
**
|
||||
** Copy bytes (a_w) through (a_w + b_w - 1) from (d) to (c).
|
||||
*/
|
||||
void
|
||||
u2_bi_bytes(u2_ray wir_r,
|
||||
c3_w a_w,
|
||||
c3_w b_w,
|
||||
c3_y* c_y,
|
||||
u2_noun d)
|
||||
{
|
||||
if ( u2_no == u2_stud(d) ) u2_bl_bail(wir_r, c3__exit);
|
||||
|
||||
u2_bytes(a_w, b_w, c_y, d);
|
||||
}
|
||||
|
||||
/* u2_bi_mp():
|
||||
**
|
||||
** Copy (b) into (a_mp).
|
||||
*/
|
||||
void
|
||||
u2_bi_mp(u2_ray wir_r,
|
||||
mpz_t a_mp,
|
||||
u2_noun b)
|
||||
{
|
||||
if ( u2_no == u2_stud(b) ) u2_bl_bail(wir_r, c3__exit);
|
||||
|
||||
u2_mp(a_mp, b);
|
||||
}
|
||||
|
||||
/* u2_bi_word():
|
||||
**
|
||||
** Return word (a_w) of (b).
|
||||
*/
|
||||
c3_w
|
||||
u2_bi_word(u2_ray wir_r,
|
||||
c3_w a_w,
|
||||
u2_noun b)
|
||||
{
|
||||
if ( u2_no == u2_stud(b) ) return u2_bl_bail(wir_r, c3__exit);
|
||||
|
||||
return u2_word(a_w, b);
|
||||
}
|
||||
|
||||
/* u2_bi_words():
|
||||
**
|
||||
** Copy words (a_w) through (a_w + b_w - 1) from (d) to (c).
|
||||
*/
|
||||
void
|
||||
u2_bi_words(u2_ray wir_r,
|
||||
c3_w a_w,
|
||||
c3_w b_w,
|
||||
c3_w* c_w,
|
||||
u2_noun d)
|
||||
{
|
||||
if ( u2_no == u2_stud(d) ) u2_bl_bail(wir_r, c3__exit);
|
||||
|
||||
u2_words(a_w, b_w, c_w, d);
|
||||
}
|
||||
|
||||
/* u2_bn_bytes():
|
||||
**
|
||||
** Copy [a] bytes from [b].
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_bytes(u2_ray wir_r,
|
||||
c3_w a_w,
|
||||
const c3_y* b_y)
|
||||
{
|
||||
return u2_bl_good(wir_r, u2_rl_bytes(wir_r, a_w, b_y));
|
||||
}
|
||||
|
||||
/* u2_bn_string():
|
||||
**
|
||||
** u2_bn_bytes(wir_r, strlen(a_c), (c3_y *)a_c);
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_string(u2_ray wir_r,
|
||||
const c3_c* a_c)
|
||||
{
|
||||
return u2_bl_good(wir_r, u2_rl_string(wir_r, a_c));
|
||||
}
|
||||
|
||||
/* u2_bn_cell():
|
||||
**
|
||||
** Produce the cell [a b].
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_cell(u2_ray wir_r,
|
||||
u2_noun a,
|
||||
u2_noun b)
|
||||
{
|
||||
return u2_bl_good(wir_r, u2_rl_cell(wir_r, a, b));
|
||||
}
|
||||
|
||||
/* u2_bn_ice():
|
||||
**
|
||||
** Produce `a`, not referencing the can. Copy or gain reference.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_ice(u2_ray wir_r,
|
||||
u2_weak a)
|
||||
{
|
||||
return u2_bl_good(wir_r, u2_rl_ice(wir_r, u2_bl_good(wir_r, a)));
|
||||
}
|
||||
|
||||
/* u2_bn_list():
|
||||
**
|
||||
** Generate a null-terminated list, with a 0 terminator.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_list(u2_ray wir_r, ...)
|
||||
{
|
||||
c3_w len_w = 0;
|
||||
va_list vap;
|
||||
|
||||
/* Count.
|
||||
*/
|
||||
{
|
||||
va_start(vap, wir_r);
|
||||
while ( u2_none != va_arg(vap, u2_noun) ) {
|
||||
len_w++;
|
||||
}
|
||||
va_end(vap);
|
||||
}
|
||||
|
||||
/* Allocate.
|
||||
*/
|
||||
{
|
||||
c3_w i_w;
|
||||
u2_noun yit[len_w];
|
||||
|
||||
va_start(vap, wir_r);
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
yit[i_w] = va_arg(vap, u2_noun);
|
||||
}
|
||||
va_end(vap);
|
||||
|
||||
/* Construct.
|
||||
*/
|
||||
{
|
||||
u2_noun woq = u2_nul;
|
||||
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
woq = u2_bc(wir_r, yit[len_w - (i_w + 1)], woq);
|
||||
}
|
||||
return woq;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bn_molt():
|
||||
**
|
||||
** Mutate `som` with a 0-terminated list of axis, noun pairs.
|
||||
** Axes must be cats (31 bit).
|
||||
**
|
||||
** Caller retains arguments; function transfers result.
|
||||
*/
|
||||
struct _molt_pair {
|
||||
c3_w axe_w;
|
||||
u2_noun som;
|
||||
};
|
||||
|
||||
static c3_w
|
||||
_molt_cut(c3_w len_w,
|
||||
struct _molt_pair* pms_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 = pms_m[i_w].axe_w;
|
||||
|
||||
if ( (cut_t == c3_false) && (3 == u2_ax_cap(axe_w)) ) {
|
||||
cut_t = c3_true;
|
||||
cut_w = i_w;
|
||||
}
|
||||
pms_m[i_w].axe_w = u2_ax_mas(axe_w);
|
||||
}
|
||||
return cut_t ? cut_w : i_w;
|
||||
}
|
||||
|
||||
static u2_noun
|
||||
_molt_apply(u2_wire wir_r,
|
||||
u2_noun som,
|
||||
c3_w len_w,
|
||||
struct _molt_pair* pms_m)
|
||||
{
|
||||
if ( len_w == 0 ) {
|
||||
return u2_rl_gain(wir_r, som);
|
||||
}
|
||||
else if ( (len_w == 1) && (1 == pms_m[0].axe_w) ) {
|
||||
return u2_rl_gain(wir_r, pms_m[0].som);
|
||||
}
|
||||
else {
|
||||
c3_w cut_w = _molt_cut(len_w, pms_m);
|
||||
|
||||
if ( u2_no == u2_dust(som) ) {
|
||||
return u2_bc
|
||||
(wir_r,
|
||||
_molt_apply(wir_r, u2_nul, cut_w, pms_m),
|
||||
_molt_apply(wir_r, u2_nul, (len_w - cut_w), (pms_m + cut_w)));
|
||||
} else {
|
||||
return u2_bc
|
||||
(wir_r,
|
||||
_molt_apply(wir_r, u2_h(som), cut_w, pms_m),
|
||||
_molt_apply(wir_r, u2_t(som), (len_w - cut_w), (pms_m + cut_w)));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bn_molf():
|
||||
**
|
||||
** As u2_bn_molt(), with argument pointer.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_molf(u2_wire wir_r,
|
||||
u2_noun som,
|
||||
va_list vap)
|
||||
{
|
||||
va_list vaq;
|
||||
c3_w len_w;
|
||||
struct _molt_pair* pms_m;
|
||||
|
||||
/* Count.
|
||||
*/
|
||||
len_w = 0;
|
||||
{
|
||||
va_copy(vaq, vap);
|
||||
while ( 1 ) {
|
||||
if ( 0 == va_arg(vaq, c3_w) ) {
|
||||
break;
|
||||
}
|
||||
va_arg(vaq, u2_noun*);
|
||||
len_w++;
|
||||
}
|
||||
va_end(vaq);
|
||||
}
|
||||
pms_m = alloca(len_w * sizeof(struct _molt_pair));
|
||||
|
||||
/* Install.
|
||||
*/
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
va_copy(vaq, vap);
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
pms_m[i_w].axe_w = va_arg(vaq, c3_w);
|
||||
pms_m[i_w].som = va_arg(vaq, u2_noun);
|
||||
}
|
||||
va_end(vaq);
|
||||
}
|
||||
|
||||
/* Apply.
|
||||
*/
|
||||
return _molt_apply(wir_r, som, len_w, pms_m);
|
||||
}
|
||||
|
||||
/* u2_bn_molt():
|
||||
**
|
||||
** Mutate `som` with a 0-terminated list of axis, noun pairs.
|
||||
** Axes must be cats (31 bit).
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_molt(u2_wire wir_r,
|
||||
u2_noun som,
|
||||
...)
|
||||
{
|
||||
va_list ap;
|
||||
c3_w len_w;
|
||||
struct _molt_pair* pms_m;
|
||||
|
||||
/* 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);
|
||||
}
|
||||
pms_m = alloca(len_w * sizeof(struct _molt_pair));
|
||||
|
||||
/* Install.
|
||||
*/
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
va_start(ap, som);
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
pms_m[i_w].axe_w = va_arg(ap, c3_w);
|
||||
pms_m[i_w].som = va_arg(ap, u2_noun);
|
||||
}
|
||||
va_end(ap);
|
||||
}
|
||||
|
||||
/* Apply.
|
||||
*/
|
||||
return _molt_apply(wir_r, som, len_w, pms_m);
|
||||
}
|
||||
|
||||
/* u2_bn_mp():
|
||||
**
|
||||
** Copy the GMP integer [a] into an atom.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_mp(u2_ray wir_r,
|
||||
mpz_t a_mp)
|
||||
{
|
||||
return u2_bl_good(wir_r, u2_rl_mp(wir_r, a_mp));
|
||||
}
|
||||
|
||||
/* u2_bn_nock():
|
||||
**
|
||||
** Nock or bail.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_nock(u2_ray wir_r, u2_noun bus, u2_noun fol)
|
||||
{
|
||||
u2_noun pro;
|
||||
|
||||
if ( (u2_none == bus) || (u2_none == fol) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
#if 1
|
||||
pro = u2_nk_nock(wir_r, u2_rl_gain(wir_r, bus), fol);
|
||||
|
||||
if ( u2_none == pro ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else return pro;
|
||||
#else
|
||||
return u2_bl_good(wir_r, u2_nk_nock(wir_r, u2_rl_gain(wir_r, bus), fol));
|
||||
#endif
|
||||
}
|
||||
|
||||
/* u2_bn_mang():
|
||||
**
|
||||
** Kick a gate, substituting axes with nouns.
|
||||
**
|
||||
** Caller retains arguments; function transfers result.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_mang(u2_wire wir_r,
|
||||
u2_noun gat,
|
||||
...)
|
||||
{
|
||||
va_list vap;
|
||||
u2_noun dur, pro;
|
||||
|
||||
va_start(vap, gat);
|
||||
dur = u2_bn_molf(wir_r, gat, vap);
|
||||
va_end(vap);
|
||||
|
||||
pro = u2_nk_nock(wir_r, dur, u2_t(dur));
|
||||
|
||||
return pro;
|
||||
}
|
||||
|
||||
/* u2_bn_hook():
|
||||
**
|
||||
** Execute hook from core.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_hook(u2_wire wir_r,
|
||||
u2_noun cor,
|
||||
const c3_c* tam_c)
|
||||
{
|
||||
u2_weak vib = u2_ds_look(wir_r, cor, tam_c);
|
||||
|
||||
if ( u2_none == vib ) {
|
||||
fprintf(stderr, "no hook: %s\n", tam_c);
|
||||
c3_assert(0);
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
} else {
|
||||
if ( u2_nul == u2_h(vib) ) {
|
||||
u2_noun rag = u2_frag(u2_t(vib), cor);
|
||||
|
||||
// printf("%s %d\n", tam_c, u2_t(vib));
|
||||
u2_rz(wir_r, vib);
|
||||
|
||||
return u2_rx(wir_r, rag);
|
||||
}
|
||||
else {
|
||||
u2_noun ret = u2_bn_nock(wir_r, cor, vib);
|
||||
|
||||
u2_rz(wir_r, vib);
|
||||
return ret;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bn_cook():
|
||||
**
|
||||
** Reverse hook as molt.
|
||||
*/
|
||||
u2_noun // transfer
|
||||
u2_bn_cook(u2_wire wir_r,
|
||||
u2_noun cor, // retain
|
||||
const c3_c* tam_c,
|
||||
u2_noun som) // transfer
|
||||
{
|
||||
u2_weak vib = u2_ds_look(wir_r, cor, tam_c);
|
||||
u2_noun axe;
|
||||
|
||||
if ( (u2_none == vib) ||
|
||||
(u2_no == u2_dust(vib)) ||
|
||||
(u2_nul != u2_h(vib)) ||
|
||||
(u2_no == u2_stud(axe = u2_t(vib)) ) )
|
||||
{
|
||||
u2_rz(wir_r, vib);
|
||||
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
} else {
|
||||
u2_noun gon = u2_bn_molt(wir_r, cor, axe, som, 0);
|
||||
|
||||
u2_rz(wir_r, vib);
|
||||
u2_rz(wir_r, som);
|
||||
return gon;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bn_mong():
|
||||
**
|
||||
** Call by gate and sample (new convention).
|
||||
** Caller retains `gat`, transfers `sam`.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_mong(u2_wire wir_r,
|
||||
u2_weak gat,
|
||||
u2_weak sam)
|
||||
{
|
||||
u2_weak pro = u2_nk_mong(wir_r, gat, sam);
|
||||
|
||||
if ( u2_none == pro ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else return pro;
|
||||
}
|
||||
|
||||
/* u2_bn_gort():
|
||||
**
|
||||
** Call by core, depth, hook, molt list.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_gort(u2_wire wir_r,
|
||||
u2_noun cor,
|
||||
const c3_c* tam_c,
|
||||
...)
|
||||
{
|
||||
// XX: tested, but leaks. Check memory protocol.
|
||||
//
|
||||
u2_noun fol = u2_bl_good(wir_r, u2_ds_look(wir_r, cor, tam_c));
|
||||
u2_noun gat = u2_bn_nock(wir_r, cor, fol);
|
||||
u2_noun tec;
|
||||
va_list vap;
|
||||
|
||||
va_start(vap, tam_c);
|
||||
tec = u2_bn_molf(wir_r, gat, vap);
|
||||
va_end(vap);
|
||||
|
||||
u2_rz(wir_r, fol);
|
||||
return u2_bn_nock(wir_r, tec, u2_t(tec));
|
||||
}
|
||||
|
||||
/* u2_bn_wait():
|
||||
**
|
||||
** Produce the functional equivalent of `|.(~(tam cor sam))`.
|
||||
*/
|
||||
u2_noun // produce
|
||||
u2_bn_wait(u2_wire wir_r,
|
||||
u2_noun cor, // retain
|
||||
u2_noun sam, // retain
|
||||
const c3_c* tam_c) // retain
|
||||
{
|
||||
c3_assert(!"not implemented"); return 0;
|
||||
#if 0
|
||||
u2_noun rac = u2_bn_molt(wir_r, cor, u2_cv_sam, sam, 0);
|
||||
u2_noun rox = u2_ds_look(wir_r, rac, tam_c);
|
||||
|
||||
if ( u2_none == rox ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
} else {
|
||||
return u2_bc
|
||||
(wir_r, rac,
|
||||
u2_bt(wir_r,
|
||||
u2_nock_flac,
|
||||
u2_bc(wir_r, 0, 2),
|
||||
rox));
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/* u2_bn_qual():
|
||||
**
|
||||
** Produce the quadruple [a b c d].
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_qual(u2_ray wir_r,
|
||||
u2_noun a,
|
||||
u2_noun b,
|
||||
u2_noun c,
|
||||
u2_noun d)
|
||||
{
|
||||
return u2_bl_good(wir_r, u2_rl_qual(wir_r, a, b, c, d));
|
||||
}
|
||||
|
||||
/* u2_bn_quil():
|
||||
**
|
||||
** Produce the quintuple [a b c d].
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_quil(u2_ray wir_r,
|
||||
u2_noun a,
|
||||
u2_noun b,
|
||||
u2_noun c,
|
||||
u2_noun d,
|
||||
u2_noun e)
|
||||
{
|
||||
return u2_bn_cell(wir_r, a, u2_bn_qual(wir_r, b, c, d, e));
|
||||
}
|
||||
|
||||
/* u2_bn_tape():
|
||||
**
|
||||
** Create an atomic string from a list of bytes.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_tape(u2_ray wir_r,
|
||||
u2_list lit)
|
||||
{
|
||||
c3_w len_w = 0;
|
||||
|
||||
{
|
||||
u2_noun ilt = lit;
|
||||
|
||||
while ( u2_nul != ilt ) { len_w++; ilt = u2_t(ilt); }
|
||||
}
|
||||
{
|
||||
c3_w lat_w = 0;
|
||||
c3_y buf_y[len_w];
|
||||
|
||||
while ( u2_nul != lit ) {
|
||||
buf_y[lat_w++] = u2_bi_byte(wir_r, 0, u2_h(lit));
|
||||
lit = u2_t(lit);
|
||||
}
|
||||
return u2_bn_bytes(wir_r, len_w, buf_y);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bn_decimal():
|
||||
**
|
||||
** On (wir_r), write (list), a list of digits, as a decimal.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_decimal(u2_ray wir_r,
|
||||
u2_list lit)
|
||||
{
|
||||
mpz_t mp;
|
||||
|
||||
mpz_init(mp);
|
||||
while ( u2_nul != lit ) {
|
||||
c3_w byt_w = u2_bi_byte(wir_r, 0, u2_h(lit));
|
||||
|
||||
mpz_mul_ui(mp, mp, 10);
|
||||
mpz_add_ui(mp, mp, (byt_w - '0'));
|
||||
|
||||
lit = u2_t(lit);
|
||||
}
|
||||
return u2_bn_mp(wir_r, mp);
|
||||
}
|
||||
|
||||
/* u2_bn_heximal():
|
||||
**
|
||||
** On (wir_r), write (lit), a list of digits, as a hexadecimal.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_heximal(u2_ray wir_r,
|
||||
u2_list lit)
|
||||
{
|
||||
mpz_t mp;
|
||||
|
||||
mpz_init(mp);
|
||||
while ( u2_nul != lit ) {
|
||||
c3_w byt_w = u2_bi_byte(wir_r, 0, u2_h(lit));
|
||||
|
||||
mpz_mul_ui(mp, mp, 16);
|
||||
if ( (byt_w >= 'a') && (byt_w <= 'f') ) {
|
||||
mpz_add_ui(mp, mp, (byt_w + 10 - 'a'));
|
||||
}
|
||||
else {
|
||||
mpz_add_ui(mp, mp, (byt_w - '0'));
|
||||
}
|
||||
lit = u2_t(lit);
|
||||
}
|
||||
return u2_bn_mp(wir_r, mp);
|
||||
}
|
||||
|
||||
/* u2_bn_trel():
|
||||
**
|
||||
** Produce the triple [a b c].
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_trel(u2_ray wir_r,
|
||||
u2_noun a,
|
||||
u2_noun b,
|
||||
u2_noun c)
|
||||
{
|
||||
return u2_bl_good(wir_r, u2_rl_trel(wir_r, a, b, c));
|
||||
}
|
||||
|
||||
/* u2_bn_words():
|
||||
**
|
||||
** Copy [a] words from [b] into an atom.
|
||||
*/
|
||||
u2_noun
|
||||
u2_bn_words(u2_ray wir_r,
|
||||
c3_w a_w,
|
||||
const c3_w* b_w)
|
||||
{
|
||||
return u2_bl_good(wir_r, u2_rl_words(wir_r, a_w, b_w));
|
||||
}
|
||||
|
||||
/* u2_bn_slab():
|
||||
**
|
||||
** Create an atomic slab of `len` words.
|
||||
*/
|
||||
u2_ray
|
||||
u2_bn_slab(u2_wire wir_r,
|
||||
c3_w len_w)
|
||||
{
|
||||
return u2_bl_some(wir_r, u2_rl_slab(wir_r, len_w));
|
||||
}
|
||||
|
||||
/* u2_bn_slaq():
|
||||
**
|
||||
** Create an atomic slab of `len` bloqs of size `met`.
|
||||
*/
|
||||
u2_ray
|
||||
u2_bn_slaq(u2_wire wir_r,
|
||||
c3_g met_g,
|
||||
c3_w len_w)
|
||||
{
|
||||
return u2_bn_slab(wir_r, ((len_w << met_g) + 31) >> 5);
|
||||
}
|
||||
|
||||
/* u2_bi_cell():
|
||||
**
|
||||
** Factor `a` as a cell `[b c].
|
||||
*/
|
||||
void
|
||||
u2_bi_cell(u2_wire wir_r,
|
||||
u2_noun a,
|
||||
u2_noun* b,
|
||||
u2_noun* c)
|
||||
{
|
||||
if ( u2_no == u2_as_cell(a, b, c) ) {
|
||||
u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bi_qual():
|
||||
**
|
||||
** Factor `a` as a quadruple `[b c d e]`.
|
||||
*/
|
||||
void
|
||||
u2_bi_qual(u2_wire wir_r,
|
||||
u2_noun a,
|
||||
u2_noun* b,
|
||||
u2_noun* c,
|
||||
u2_noun* d,
|
||||
u2_noun* e)
|
||||
{
|
||||
if ( u2_no == u2_as_qual(a, b, c, d, e) ) {
|
||||
u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bi_quil():
|
||||
**
|
||||
** Factor `a` as a quintuple `[b c d e f]`, or bail.
|
||||
*/
|
||||
void
|
||||
u2_bi_quil(u2_wire wir_r,
|
||||
u2_noun a,
|
||||
u2_noun* b,
|
||||
u2_noun* c,
|
||||
u2_noun* d,
|
||||
u2_noun* e,
|
||||
u2_noun* f)
|
||||
{
|
||||
if ( u2_no == u2_as_quil(a, b, c, d, e, f) ) {
|
||||
u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bi_trel():
|
||||
**
|
||||
** Factor `a` as a trel `[b c d]`, or bail.
|
||||
*/
|
||||
void
|
||||
u2_bi_trel(u2_wire wir_r,
|
||||
u2_noun a,
|
||||
u2_noun* b,
|
||||
u2_noun* c,
|
||||
u2_noun* d)
|
||||
{
|
||||
if ( u2_no == u2_as_trel(a, b, c, d) ) {
|
||||
u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
}
|
||||
|
||||
563
f/benx.c
563
f/benx.c
@ -1,563 +0,0 @@
|
||||
/* f/benx.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* u2_bx_boot(): reset the performance log.
|
||||
*/
|
||||
void
|
||||
u2_bx_boot(u2_ray wir_r)
|
||||
{
|
||||
u2_ray bex_r;
|
||||
|
||||
if ( 0 == (bex_r = u2_wire_bex_r(wir_r)) ) {
|
||||
return;
|
||||
} else {
|
||||
u2_benx_at(bex_r, zat) = u2_nul;
|
||||
u2_benx_at(bex_r, zof) = u2_nul;
|
||||
|
||||
u2_benx_be(bex_r, c3_d, sap_d) = 0;
|
||||
u2_benx_be(bex_r, c3_d, cop_d) = 0;
|
||||
u2_benx_be(bex_r, c3_d, det_d) = 0;
|
||||
u2_benx_be(bex_r, c3_d, jax_d) = 0;
|
||||
u2_benx_be(bex_r, c3_d, use_d) = 0;
|
||||
|
||||
u2_benx_be(bex_r, c3_w, wac_w) = 0;
|
||||
u2_benx_be(bex_r, c3_w, wax_w) = 0;
|
||||
|
||||
u2_benx_be(bex_r, c3_w, lif_w) = u2_soup_liv_w(u2_rail_rut_r(wir_r));
|
||||
u2_benx_be(bex_r, c3_w, bos_w) =
|
||||
u2_soup_liv_w(u2_rail_rut_r(u2_wire_bas_r(wir_r)));
|
||||
|
||||
{
|
||||
struct timeval tv;
|
||||
|
||||
gettimeofday(&tv, 0);
|
||||
u2_benx_at(bex_r, sec_w) = tv.tv_sec;
|
||||
u2_benx_at(bex_r, usc_w) = tv.tv_usec;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_post(): export and reset the performance log.
|
||||
**
|
||||
** zat: source position stack (on shed)
|
||||
** zof: programer action stack (on shed)
|
||||
** sap: number of steps
|
||||
** cop: number of words copied
|
||||
** det: number of identical nouns compared
|
||||
** jax: number of jet activations
|
||||
** use: number of user counts
|
||||
** wax: maximum depth of C stack
|
||||
** viq: words in wire allocated
|
||||
** zor: words in basket allocated
|
||||
** ums: number of milliseconds consumed
|
||||
*/
|
||||
u2_bean
|
||||
u2_bx_post(u2_ray wir_r,
|
||||
u2_noun* zat,
|
||||
u2_noun* zof,
|
||||
c3_d* sap_d,
|
||||
c3_d* cop_d,
|
||||
c3_d* det_d,
|
||||
c3_d* jax_d,
|
||||
c3_d* use_d,
|
||||
c3_w* wax_w,
|
||||
c3_ws* viq_ws,
|
||||
c3_ws* zor_ws,
|
||||
c3_w* ums_w)
|
||||
{
|
||||
u2_ray bex_r;
|
||||
|
||||
if ( 0 == (bex_r = u2_wire_bex_r(wir_r)) ) {
|
||||
return u2_no;
|
||||
} else {
|
||||
c3_w sec_w, usc_w;
|
||||
|
||||
*zat = u2_benx_at(bex_r, zat);
|
||||
*zof = u2_benx_at(bex_r, zof);
|
||||
|
||||
*sap_d = u2_benx_be(bex_r, c3_d, sap_d);
|
||||
*cop_d = u2_benx_be(bex_r, c3_d, cop_d);
|
||||
*det_d = u2_benx_be(bex_r, c3_d, det_d);
|
||||
*jax_d = u2_benx_be(bex_r, c3_d, jax_d);
|
||||
*use_d = u2_benx_be(bex_r, c3_d, use_d);
|
||||
|
||||
*wax_w = u2_benx_at(bex_r, wax_w);
|
||||
|
||||
*viq_ws = u2_soup_liv_w(u2_rail_rut_r(wir_r)) -
|
||||
u2_benx_be(bex_r, c3_w, lif_w);
|
||||
|
||||
*zor_ws = u2_soup_liv_w(u2_rail_rut_r(u2_wire_bas_r(wir_r))) -
|
||||
u2_benx_be(bex_r, c3_w, bos_w);
|
||||
|
||||
sec_w = u2_benx_at(bex_r, sec_w);
|
||||
usc_w = u2_benx_at(bex_r, usc_w);
|
||||
u2_bx_boot(wir_r);
|
||||
|
||||
/* Measure and return time change.
|
||||
*/
|
||||
{
|
||||
c3_d old_d, new_d;
|
||||
|
||||
old_d = sec_w;
|
||||
old_d *= 1000000ULL;
|
||||
old_d += usc_w;
|
||||
|
||||
new_d = u2_benx_at(bex_r, sec_w);
|
||||
new_d *= 1000000ULL;
|
||||
new_d += u2_benx_at(bex_r, usc_w);
|
||||
|
||||
*ums_w = (c3_w) (((new_d - old_d) + 999ULL) / 1000ULL);
|
||||
}
|
||||
return u2_yes;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_step(): note interpreter step.
|
||||
*/
|
||||
void
|
||||
u2_bx_step(u2_ray wir_r)
|
||||
{
|
||||
u2_ray bex_r;
|
||||
|
||||
if ( 0 == (bex_r = u2_wire_bex_r(wir_r)) ) {
|
||||
return;
|
||||
} else {
|
||||
u2_benx_be(bex_r, c3_d, sap_d) += (c3_d) 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_copy(): note `cop` copied words.
|
||||
*/
|
||||
void
|
||||
u2_bx_copy(u2_ray wir_r,
|
||||
c3_w cop_w)
|
||||
{
|
||||
u2_ray bex_r;
|
||||
|
||||
if ( 0 == (bex_r = u2_wire_bex_r(wir_r)) ) {
|
||||
return;
|
||||
} else {
|
||||
u2_benx_be(bex_r, c3_d, cop_d) += (c3_d) cop_w;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_dent(): note `det` identical comparisons.
|
||||
*/
|
||||
void
|
||||
u2_bx_dent(u2_ray wir_r,
|
||||
c3_w det_w)
|
||||
{
|
||||
u2_ray bex_r;
|
||||
|
||||
if ( 0 == (bex_r = u2_wire_bex_r(wir_r)) ) {
|
||||
return;
|
||||
} else {
|
||||
u2_benx_be(bex_r, c3_d, det_d) += (c3_d) det_w;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_sink(): go deeper (call) in the C stack.
|
||||
*/
|
||||
void
|
||||
u2_bx_sink(u2_ray wir_r)
|
||||
{
|
||||
u2_ray bex_r;
|
||||
|
||||
if ( 0 == (bex_r = u2_wire_bex_r(wir_r)) ) {
|
||||
return;
|
||||
} else {
|
||||
u2_benx_at(bex_r, wac_w) += 1;
|
||||
|
||||
if ( u2_benx_at(bex_r, wac_w) > u2_benx_at(bex_r, wax_w) ) {
|
||||
u2_benx_at(bex_r, wax_w) = u2_benx_at(bex_r, wac_w);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_rise(): go shallower (return) in the C stack.
|
||||
*/
|
||||
void
|
||||
u2_bx_rise(u2_ray wir_r)
|
||||
{
|
||||
u2_ray bex_r;
|
||||
|
||||
if ( 0 == (bex_r = u2_wire_bex_r(wir_r)) ) {
|
||||
return;
|
||||
} else {
|
||||
u2_benx_at(bex_r, wac_w) -= 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_used(): report a user count.
|
||||
*/
|
||||
void
|
||||
u2_bx_used(u2_ray wir_r)
|
||||
{
|
||||
u2_ray bex_r;
|
||||
|
||||
if ( 0 == (bex_r = u2_wire_bex_r(wir_r)) ) {
|
||||
return;
|
||||
} else {
|
||||
u2_benx_be(bex_r, c3_d, use_d) += (c3_d) 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_flew(): report a jet activation.
|
||||
*/
|
||||
void
|
||||
u2_bx_flew(u2_ray wir_r)
|
||||
{
|
||||
u2_ray bex_r;
|
||||
|
||||
if ( 0 == (bex_r = u2_wire_bex_r(wir_r)) ) {
|
||||
return;
|
||||
} else {
|
||||
u2_benx_be(bex_r, c3_d, jax_d) += (c3_d) 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_spot(): declare source position.
|
||||
*/
|
||||
void
|
||||
u2_bx_spot(u2_ray wir_r,
|
||||
u2_noun hod) // transfer
|
||||
{
|
||||
u2_ray bex_r, bas_r;
|
||||
|
||||
if ( (0 == (bex_r = u2_wire_bex_r(wir_r))) ||
|
||||
(0 == (bas_r = u2_wire_bas_r(wir_r))) )
|
||||
{
|
||||
u2_rl_lose(wir_r, hod);
|
||||
return;
|
||||
}
|
||||
else {
|
||||
u2_noun sud = u2_rl_take(bas_r, hod);
|
||||
|
||||
u2_rl_lose(wir_r, hod);
|
||||
if ( u2_none == sud ) {
|
||||
return;
|
||||
} else {
|
||||
u2_rl_lose(wir_r, u2_benx_at(bex_r, zat));
|
||||
|
||||
u2_benx_at(bex_r, zat) = sud;
|
||||
}
|
||||
}
|
||||
}
|
||||
void
|
||||
u2_bx_spot_out(u2_ray wir_r)
|
||||
{
|
||||
u2_ray bex_r, bas_r;
|
||||
|
||||
if ( (0 == (bex_r = u2_wire_bex_r(wir_r))) ||
|
||||
(0 == (bas_r = u2_wire_bas_r(wir_r))) )
|
||||
{
|
||||
return;
|
||||
}
|
||||
else {
|
||||
u2_noun zat = u2_benx_at(bex_r, zat);
|
||||
|
||||
c3_assert(u2_nul != zat);
|
||||
|
||||
u2_benx_at(bex_r, zat) = u2_t(zat);
|
||||
u2_rl_lose(wir_r, zat);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_bean_ent(), u2_bx_bean_out(): enter and exit source position.
|
||||
*/
|
||||
void
|
||||
u2_bx_bean_ent(u2_ray wir_r,
|
||||
u2_noun hod) // transfer
|
||||
{
|
||||
u2_ray bex_r, bas_r;
|
||||
|
||||
if ( (0 == (bex_r = u2_wire_bex_r(wir_r))) ||
|
||||
(0 == (bas_r = u2_wire_bas_r(wir_r))) )
|
||||
{
|
||||
u2_rl_lose(wir_r, hod);
|
||||
return;
|
||||
}
|
||||
else {
|
||||
u2_noun naz = u2_rl_uniq(wir_r, hod);
|
||||
|
||||
u2_rl_lose(wir_r, hod);
|
||||
if ( u2_none != naz ) {
|
||||
u2_noun zof = u2_rc
|
||||
(bas_r, u2_rx(bas_r, naz), u2_rx(bas_r, u2_benx_at(bex_r, zof)));
|
||||
|
||||
if ( u2_none != zof ) {
|
||||
u2_rl_lose(bas_r, u2_benx_at(bex_r, zof));
|
||||
u2_benx_at(bex_r, zof) = zof;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
u2_bx_bean_out(u2_ray wir_r)
|
||||
{
|
||||
u2_ray bex_r, bas_r;
|
||||
|
||||
if ( (0 == (bex_r = u2_wire_bex_r(wir_r))) ||
|
||||
(0 == (bas_r = u2_wire_bas_r(wir_r))) )
|
||||
{
|
||||
return;
|
||||
}
|
||||
else {
|
||||
u2_noun zof = u2_benx_at(bex_r, zof);
|
||||
|
||||
c3_assert(u2_nul != zof);
|
||||
|
||||
u2_benx_at(bex_r, zof) = u2_rx(bas_r, u2_t(zof));
|
||||
u2_rl_lose(bas_r, zof);
|
||||
}
|
||||
}
|
||||
|
||||
/* _print_tape(): print a byte tape.
|
||||
*/
|
||||
static void
|
||||
_print_tape(u2_noun som,
|
||||
FILE* fil_F)
|
||||
{
|
||||
u2_noun h_som;
|
||||
|
||||
while ( (u2_yes == u2_dust(som)) && ((h_som = u2_h(som)) < 128) ) {
|
||||
putc(h_som, fil_F);
|
||||
som = u2_t(som);
|
||||
}
|
||||
}
|
||||
|
||||
/* _print_term(): print a terminal.
|
||||
*/
|
||||
static void
|
||||
_print_term(u2_noun som,
|
||||
FILE* fil_F)
|
||||
{
|
||||
if ( u2_yes == u2_stud(som) ) {
|
||||
c3_w len_w = u2_met(3, som);
|
||||
c3_y *som_y = alloca(len_w) + 1;
|
||||
|
||||
u2_bytes(0, len_w, som_y, som);
|
||||
som_y[len_w] = 0;
|
||||
fprintf(fil_F, "%s", (c3_c *)som_y);
|
||||
}
|
||||
}
|
||||
|
||||
/* _print_space(): print `feq_w` spaces.
|
||||
*/
|
||||
static void
|
||||
_print_space(c3_w feq_w,
|
||||
FILE* fil_F)
|
||||
{
|
||||
while ( feq_w-- ) {
|
||||
putc(' ', fil_F);
|
||||
}
|
||||
}
|
||||
|
||||
/* _print_wall(): print debug wall.
|
||||
*/
|
||||
static void
|
||||
_print_wall(u2_noun wal,
|
||||
FILE* fil_F)
|
||||
{
|
||||
while ( u2_yes == u2_dust(wal) ) {
|
||||
_print_tape(u2_h(wal), fil_F);
|
||||
putc('\n', fil_F);
|
||||
wal = u2_t(wal);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_loaf(): print debug loaf.
|
||||
*/
|
||||
void
|
||||
u2_bx_loaf(u2_ray wir_r,
|
||||
u2_noun luf) // retain
|
||||
{
|
||||
if ( u2_yes == u2_dust(luf) ) {
|
||||
_print_term(u2_h(luf), stdout);
|
||||
printf(":\n");
|
||||
_print_wall(u2_t(luf), stdout);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_bean_print(): print bean stack to FILE *.
|
||||
*/
|
||||
void
|
||||
u2_bx_bean_print(u2_ray wir_r,
|
||||
FILE * fil_F,
|
||||
u2_noun zof) // retain
|
||||
{
|
||||
while ( u2_yes == u2_dust(zof) ) {
|
||||
u2_noun i_zof = u2_h(zof);
|
||||
u2_noun t_zof = u2_t(zof);
|
||||
|
||||
if ( u2_yes == u2_stud(i_zof) ) {
|
||||
_print_term(i_zof, fil_F);
|
||||
fprintf(fil_F, "\n");
|
||||
} else {
|
||||
u2_noun hi_zof = u2_h(i_zof);
|
||||
u2_noun ti_zof = u2_t(i_zof);
|
||||
u2_weak gol;
|
||||
|
||||
gol = u2_nk_kick(wir_r, ti_zof);
|
||||
if ( u2_none == gol ) {
|
||||
_print_term(hi_zof, fil_F);
|
||||
fprintf(fil_F, ":!\n");
|
||||
}
|
||||
else {
|
||||
u2_noun gal = gol;
|
||||
|
||||
if ( u2_nul == hi_zof ) {
|
||||
while ( u2_yes == u2_dust(gal) ) {
|
||||
_print_tape(u2_h(gal), fil_F);
|
||||
fprintf(fil_F, "\n");
|
||||
gal = u2_t(gal);
|
||||
}
|
||||
}
|
||||
else {
|
||||
c3_w feq_w = u2_met(3, hi_zof);
|
||||
|
||||
_print_term(hi_zof, fil_F);
|
||||
printf(": ");
|
||||
|
||||
while ( u2_yes == u2_dust(gal) ) {
|
||||
if ( gal != gol ) {
|
||||
_print_space(feq_w + 2, fil_F);
|
||||
}
|
||||
_print_tape(u2_h(gal), fil_F);
|
||||
fprintf(fil_F, "\n");
|
||||
gal = u2_t(gal);
|
||||
}
|
||||
}
|
||||
u2_rl_lose(wir_r, gol);
|
||||
}
|
||||
}
|
||||
zof = t_zof;
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
_bx_print_superdecimal_w(c3_w w)
|
||||
{
|
||||
if ( w < 65536 ) {
|
||||
printf("%d", w);
|
||||
} else {
|
||||
printf("%d+%d", (w >> 16), (w & 65535));
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
_bx_print_superdecimal_ws(c3_ws ws)
|
||||
{
|
||||
if ( ws < 0 ) {
|
||||
printf("-");
|
||||
_bx_print_superdecimal_w((c3_w) -(ws));
|
||||
} else {
|
||||
_bx_print_superdecimal_w((c3_w) ws);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
_bx_print_superdecimal_d(c3_d d)
|
||||
{
|
||||
if ( d > 0x100000000ULL ) {
|
||||
_bx_print_superdecimal_w((c3_w)(d >> 32ULL));
|
||||
printf(":");
|
||||
_bx_print_superdecimal_w((c3_w)(d & 0xffffffffULL));
|
||||
}
|
||||
else {
|
||||
_bx_print_superdecimal_w((c3_w) d);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_bx_show(): print benchmark report and clear structure.
|
||||
*/
|
||||
void
|
||||
u2_bx_show(u2_ray wir_r)
|
||||
{
|
||||
u2_noun zat, zof;
|
||||
c3_d sap_d, cop_d, det_d, jax_d, use_d;
|
||||
c3_w wax_w, ums_w;
|
||||
c3_ws viq_ws, zor_ws;
|
||||
|
||||
if ( u2_no == u2_bx_post(wir_r, &zat,
|
||||
&zof,
|
||||
&sap_d,
|
||||
&cop_d,
|
||||
&det_d,
|
||||
&jax_d,
|
||||
&use_d,
|
||||
&wax_w,
|
||||
&viq_ws,
|
||||
&zor_ws,
|
||||
&ums_w) )
|
||||
{
|
||||
return;
|
||||
} else {
|
||||
/* Dump and free trace information, if any.
|
||||
*/
|
||||
{
|
||||
u2_ray bas_r = u2_wire_bas_r(wir_r);
|
||||
|
||||
if ( u2_nul != zat ) {
|
||||
// u2_noun h_zat = u2_h(zat);
|
||||
u2_noun t_zat = u2_t(zat);
|
||||
|
||||
printf("place: %d.%d:%d.%d\n",
|
||||
u2_h(u2_h(t_zat)), u2_t(u2_h(t_zat)),
|
||||
u2_h(u2_t(t_zat)), u2_t(u2_t(t_zat)));
|
||||
u2_rl_lose(bas_r, zat);
|
||||
}
|
||||
|
||||
if ( u2_nul != zof ) {
|
||||
printf("trace:\n");
|
||||
u2_bx_bean_print(wir_r, stdout, zof);
|
||||
u2_rl_lose(bas_r, zof);
|
||||
}
|
||||
}
|
||||
|
||||
/* Dump performance log.
|
||||
*/
|
||||
{
|
||||
printf("<");
|
||||
_bx_print_superdecimal_d(sap_d);
|
||||
printf(" hops");
|
||||
if ( cop_d ) {
|
||||
printf(", ");
|
||||
_bx_print_superdecimal_d(cop_d);
|
||||
printf(" dups");
|
||||
}
|
||||
if ( det_d ) {
|
||||
printf(", ");
|
||||
_bx_print_superdecimal_d(det_d);
|
||||
printf(" nods");
|
||||
}
|
||||
if ( use_d ) {
|
||||
printf(", ");
|
||||
_bx_print_superdecimal_d(use_d);
|
||||
printf(" pings");
|
||||
}
|
||||
printf(", ");
|
||||
_bx_print_superdecimal_w(wax_w);
|
||||
printf(" deep");
|
||||
|
||||
if ( viq_ws ) {
|
||||
printf("; ");
|
||||
_bx_print_superdecimal_ws(viq_ws);
|
||||
printf(" kept");
|
||||
}
|
||||
if ( zor_ws ) {
|
||||
printf(", ");
|
||||
_bx_print_superdecimal_ws(zor_ws);
|
||||
printf(" held");
|
||||
}
|
||||
|
||||
printf("; ");
|
||||
_bx_print_superdecimal_w(ums_w);
|
||||
printf(" ms>\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
955
f/cash.c
955
f/cash.c
@ -1,955 +0,0 @@
|
||||
/* f/cash.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/** Forward declarations.
|
||||
**/
|
||||
static u2_bean
|
||||
_cs_save_in(u2_rail, u2_ray, c3_w, c3_w, c3_m, u2_noun, u2_noun);
|
||||
|
||||
static u2_bean
|
||||
_cs_save_b(u2_rail, u2_ray, c3_w, c3_w, c3_m, u2_noun, u2_noun);
|
||||
|
||||
/* _cs_find_sap(): check if sample matches list; if not, add.
|
||||
*/
|
||||
static u2_bean
|
||||
_cs_find_sap(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
u2_noun sam) // retain
|
||||
{
|
||||
u2_noun sap = u2_slot_a_sap(lot_r);
|
||||
{
|
||||
u2_noun pos = sap;
|
||||
|
||||
while ( u2_nul != pos ) {
|
||||
if ( u2_yes == u2_fing(sam, u2_h(pos)) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
pos = u2_t(pos);
|
||||
}
|
||||
}
|
||||
if ( u2_yes == u2_sing(sam, u2_h(sap)) ) {
|
||||
if ( u2_no == u2_rl_junior(ral_r, sam) ) {
|
||||
u2_slot_a_sap(lot_r) = u2_rc(ral_r, u2_rx(ral_r, sam), sap);
|
||||
}
|
||||
return u2_yes;
|
||||
}
|
||||
else return u2_no;
|
||||
}
|
||||
|
||||
/* _cs_find_sap_cell(): _cs_find_sap() for cell.
|
||||
*/
|
||||
static u2_bean
|
||||
_cs_find_sap_cell(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
u2_noun a_sam, // retain
|
||||
u2_noun b_sam) // retain
|
||||
{
|
||||
u2_noun sap = u2_slot_a_sap(lot_r);
|
||||
{
|
||||
u2_noun pos = sap;
|
||||
|
||||
while ( u2_nul != pos ) {
|
||||
if ( u2_yes == u2_fing_cell(a_sam, b_sam, u2_h(pos)) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
pos = u2_t(pos);
|
||||
}
|
||||
}
|
||||
if ( u2_yes == u2_sing_cell(a_sam, b_sam, u2_h(sap)) ) {
|
||||
if ( (u2_no == u2_rl_junior(ral_r, a_sam)) &&
|
||||
(u2_no == u2_rl_junior(ral_r, b_sam)) )
|
||||
{
|
||||
u2_noun sam = u2_rc(ral_r, u2_rx(ral_r, a_sam),
|
||||
u2_rx(ral_r, b_sam));
|
||||
|
||||
if ( u2_none != sam ) {
|
||||
u2_slot_a_sap(lot_r) = u2_rc(ral_r, sam, sap);
|
||||
}
|
||||
}
|
||||
return u2_yes;
|
||||
}
|
||||
else return u2_no;
|
||||
}
|
||||
|
||||
/* _cs_find_sap_mixt(): _cs_find_sap() for mixed cell.
|
||||
*/
|
||||
static u2_bean
|
||||
_cs_find_sap_mixt(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
const c3_c* a_sam_c, // retain
|
||||
u2_noun b_sam) // retain
|
||||
{
|
||||
u2_noun sap = u2_slot_a_sap(lot_r);
|
||||
{
|
||||
u2_noun pos = sap;
|
||||
|
||||
while ( u2_nul != pos ) {
|
||||
if ( u2_yes == u2_fing_mixt(a_sam_c, b_sam, u2_h(pos)) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
pos = u2_t(pos);
|
||||
}
|
||||
}
|
||||
if ( u2_yes == u2_sing_mixt(a_sam_c, b_sam, u2_h(sap)) ) {
|
||||
if ( u2_no == u2_rl_junior(ral_r, b_sam) ) {
|
||||
u2_noun sam = u2_rc(ral_r, u2_rl_string(ral_r, a_sam_c),
|
||||
u2_rx(ral_r, b_sam));
|
||||
|
||||
if ( u2_none != sam ) {
|
||||
u2_slot_a_sap(lot_r) = u2_rc(ral_r, sam, sap);
|
||||
}
|
||||
}
|
||||
return u2_yes;
|
||||
}
|
||||
else return u2_no;
|
||||
}
|
||||
|
||||
/* _cs_find_sap_trel(): _cs_find_sap() for cell.
|
||||
*/
|
||||
static u2_bean
|
||||
_cs_find_sap_trel(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
u2_noun a_sam, // retain
|
||||
u2_noun b_sam, // retain
|
||||
u2_noun c_sam) // retain
|
||||
{
|
||||
u2_noun sap = u2_slot_a_sap(lot_r);
|
||||
{
|
||||
u2_noun pos = sap;
|
||||
|
||||
while ( u2_nul != pos ) {
|
||||
if ( u2_yes == u2_fing_trel(a_sam, b_sam, c_sam, u2_h(pos)) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
pos = u2_t(pos);
|
||||
}
|
||||
}
|
||||
if ( u2_yes == u2_sing_trel(a_sam, b_sam, c_sam, u2_h(sap)) ) {
|
||||
if ( (u2_no == u2_rl_junior(ral_r, a_sam)) &&
|
||||
(u2_no == u2_rl_junior(ral_r, b_sam)) &&
|
||||
(u2_no == u2_rl_junior(ral_r, c_sam)) )
|
||||
{
|
||||
u2_noun sam = u2_rt(ral_r, u2_rx(ral_r, a_sam),
|
||||
u2_rx(ral_r, b_sam),
|
||||
u2_rx(ral_r, c_sam));
|
||||
|
||||
if ( u2_none != sam ) {
|
||||
u2_slot_a_sap(lot_r) = u2_rc(ral_r, sam, sap);
|
||||
}
|
||||
}
|
||||
return u2_yes;
|
||||
}
|
||||
else return u2_no;
|
||||
}
|
||||
|
||||
/* _cs_find_sap_qual(): _cs_find_sap() for cell.
|
||||
*/
|
||||
static u2_bean
|
||||
_cs_find_sap_qual(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
u2_noun a_sam, // retain
|
||||
u2_noun b_sam, // retain
|
||||
u2_noun c_sam, // retain
|
||||
u2_noun d_sam) // retain
|
||||
{
|
||||
u2_noun sap = u2_slot_a_sap(lot_r);
|
||||
{
|
||||
u2_noun pos = sap;
|
||||
|
||||
while ( u2_nul != pos ) {
|
||||
if ( u2_yes == u2_fing_qual(a_sam, b_sam, c_sam, d_sam, u2_h(pos)) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
pos = u2_t(pos);
|
||||
}
|
||||
}
|
||||
if ( u2_yes == u2_sing_qual(a_sam, b_sam, c_sam, d_sam, u2_h(sap)) ) {
|
||||
if ( (u2_no == u2_rl_junior(ral_r, a_sam)) &&
|
||||
(u2_no == u2_rl_junior(ral_r, b_sam)) &&
|
||||
(u2_no == u2_rl_junior(ral_r, c_sam)) &&
|
||||
(u2_no == u2_rl_junior(ral_r, d_sam)) )
|
||||
{
|
||||
u2_noun sam = u2_rq(ral_r, u2_rx(ral_r, a_sam),
|
||||
u2_rx(ral_r, b_sam),
|
||||
u2_rx(ral_r, c_sam),
|
||||
u2_rx(ral_r, d_sam));
|
||||
|
||||
if ( u2_none != sam ) {
|
||||
u2_slot_a_sap(lot_r) = u2_rc(ral_r, sam, sap);
|
||||
}
|
||||
}
|
||||
return u2_yes;
|
||||
}
|
||||
else return u2_no;
|
||||
}
|
||||
|
||||
/* _cs_find_1()::
|
||||
*/
|
||||
static u2_weak // retain
|
||||
_cs_find_1(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_w key_w,
|
||||
c3_w sif_w,
|
||||
c3_m sel_m,
|
||||
u2_noun sam) // retain
|
||||
{
|
||||
top: {
|
||||
if ( u2_slot_is_a(lot_r) ) {
|
||||
if ( (sel_m == u2_slot_a_sel(lot_r)) &&
|
||||
(u2_yes == _cs_find_sap(ral_r, lot_r, sam)) )
|
||||
{
|
||||
return u2_slot_a_pro(lot_r);
|
||||
} else {
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
else if ( u2_slot_is_c(lot_r) ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
c3_w gun_w = u2_slot_b_gun(lot_r);
|
||||
c3_w i_w = (key_w >> sif_w) & 15;
|
||||
|
||||
if ( u2_slot_gunk_is_coll(gun_w) ) {
|
||||
c3_w j_w = i_w;
|
||||
|
||||
do {
|
||||
u2_ray tol_r = u2_slot_b_sid_i(lot_r, j_w);
|
||||
|
||||
if ( u2_slot_is_a(tol_r) &&
|
||||
(sel_m == u2_slot_a_sel(tol_r)) &&
|
||||
(u2_yes == _cs_find_sap(ral_r, tol_r, sam)) )
|
||||
{
|
||||
return u2_slot_a_pro(tol_r);
|
||||
}
|
||||
|
||||
j_w = ((j_w + 1) & 15);
|
||||
}
|
||||
while ( j_w != i_w );
|
||||
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
lot_r = u2_slot_b_sid_i(lot_r, i_w);
|
||||
sif_w += 4;
|
||||
goto top;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cs_find_2()::
|
||||
*/
|
||||
static u2_weak // retain
|
||||
_cs_find_2(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_w key_w,
|
||||
c3_w sif_w,
|
||||
c3_m sel_m,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
top: {
|
||||
if ( u2_slot_is_a(lot_r) ) {
|
||||
if ( (sel_m == u2_slot_a_sel(lot_r)) &&
|
||||
(u2_yes == _cs_find_sap_cell(ral_r, lot_r, a, b)) )
|
||||
{
|
||||
return u2_slot_a_pro(lot_r);
|
||||
} else {
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
else if ( u2_slot_is_c(lot_r) ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
c3_w gun_w = u2_slot_b_gun(lot_r);
|
||||
c3_w i_w = (key_w >> sif_w) & 15;
|
||||
|
||||
if ( u2_slot_gunk_is_coll(gun_w) ) {
|
||||
c3_w j_w = i_w;
|
||||
|
||||
do {
|
||||
u2_ray tol_r = u2_slot_b_sid_i(lot_r, j_w);
|
||||
|
||||
if ( u2_slot_is_a(tol_r) &&
|
||||
(sel_m == u2_slot_a_sel(tol_r)) &&
|
||||
(u2_yes == _cs_find_sap_cell(ral_r, tol_r, a, b)) )
|
||||
{
|
||||
return u2_slot_a_pro(tol_r);
|
||||
}
|
||||
|
||||
j_w = ((j_w + 1) & 15);
|
||||
}
|
||||
while ( j_w != i_w );
|
||||
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
lot_r = u2_slot_b_sid_i(lot_r, i_w);
|
||||
sif_w += 4;
|
||||
goto top;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cs_find_2m()::
|
||||
*/
|
||||
static u2_weak // retain
|
||||
_cs_find_2m(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_w key_w,
|
||||
c3_w sif_w,
|
||||
c3_m sel_m,
|
||||
const c3_c* a_c, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
top: {
|
||||
if ( u2_slot_is_a(lot_r) ) {
|
||||
if ( (sel_m == u2_slot_a_sel(lot_r)) &&
|
||||
(u2_yes == _cs_find_sap_mixt(ral_r, lot_r, a_c, b)) )
|
||||
{
|
||||
return u2_slot_a_pro(lot_r);
|
||||
} else {
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
else if ( u2_slot_is_c(lot_r) ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
c3_w gun_w = u2_slot_b_gun(lot_r);
|
||||
c3_w i_w = (key_w >> sif_w) & 15;
|
||||
|
||||
if ( u2_slot_gunk_is_coll(gun_w) ) {
|
||||
c3_w j_w = i_w;
|
||||
|
||||
do {
|
||||
u2_ray tol_r = u2_slot_b_sid_i(lot_r, j_w);
|
||||
|
||||
if ( u2_slot_is_a(tol_r) &&
|
||||
(sel_m == u2_slot_a_sel(tol_r)) &&
|
||||
(u2_yes == _cs_find_sap_mixt(ral_r, tol_r, a_c, b)) )
|
||||
{
|
||||
return u2_slot_a_pro(tol_r);
|
||||
}
|
||||
|
||||
j_w = ((j_w + 1) & 15);
|
||||
}
|
||||
while ( j_w != i_w );
|
||||
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
lot_r = u2_slot_b_sid_i(lot_r, i_w);
|
||||
sif_w += 4;
|
||||
goto top;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cs_find_3()::
|
||||
*/
|
||||
static u2_weak // retain
|
||||
_cs_find_3(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_w key_w,
|
||||
c3_w sif_w,
|
||||
c3_m sel_m,
|
||||
u2_noun a, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun c) // retain
|
||||
{
|
||||
top: {
|
||||
if ( u2_slot_is_a(lot_r) ) {
|
||||
if ( (sel_m == u2_slot_a_sel(lot_r)) &&
|
||||
(u2_yes == _cs_find_sap_trel(ral_r, lot_r, a, b, c) ) )
|
||||
{
|
||||
return u2_slot_a_pro(lot_r);
|
||||
} else {
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
else if ( u2_slot_is_c(lot_r) ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
c3_w gun_w = u2_slot_b_gun(lot_r);
|
||||
c3_w i_w = (key_w >> sif_w) & 15;
|
||||
|
||||
if ( u2_slot_gunk_is_coll(gun_w) ) {
|
||||
c3_w j_w = i_w;
|
||||
|
||||
do {
|
||||
u2_ray tol_r = u2_slot_b_sid_i(lot_r, j_w);
|
||||
|
||||
if ( u2_slot_is_a(tol_r) &&
|
||||
(sel_m == u2_slot_a_sel(tol_r)) &&
|
||||
(u2_yes == _cs_find_sap_trel(ral_r, tol_r, a, b, c) ) )
|
||||
{
|
||||
return u2_slot_a_pro(tol_r);
|
||||
}
|
||||
|
||||
j_w = ((j_w + 1) & 15);
|
||||
}
|
||||
while ( j_w != i_w );
|
||||
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
lot_r = u2_slot_b_sid_i(lot_r, i_w);
|
||||
sif_w += 4;
|
||||
goto top;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cs_find_4()::
|
||||
*/
|
||||
static u2_weak // retain
|
||||
_cs_find_4(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_w key_w,
|
||||
c3_w sif_w,
|
||||
c3_m sel_m,
|
||||
u2_noun a, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun c, // retain
|
||||
u2_noun d) // retain
|
||||
{
|
||||
top: {
|
||||
if ( u2_slot_is_a(lot_r) ) {
|
||||
if ( (sel_m == u2_slot_a_sel(lot_r)) &&
|
||||
(u2_yes == _cs_find_sap_qual(ral_r, lot_r, a, b, c, d) ) )
|
||||
{
|
||||
return u2_slot_a_pro(lot_r);
|
||||
} else {
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
else if ( u2_slot_is_c(lot_r) ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
c3_w gun_w = u2_slot_b_gun(lot_r);
|
||||
c3_w i_w = (key_w >> sif_w) & 15;
|
||||
|
||||
if ( u2_slot_gunk_is_coll(gun_w) ) {
|
||||
c3_w j_w = i_w;
|
||||
|
||||
do {
|
||||
u2_ray tol_r = u2_slot_b_sid_i(lot_r, j_w);
|
||||
|
||||
if ( u2_slot_is_a(tol_r) &&
|
||||
(sel_m == u2_slot_a_sel(tol_r)) &&
|
||||
(u2_yes == _cs_find_sap_qual(ral_r, tol_r, a, b, c, d) ) )
|
||||
{
|
||||
return u2_slot_a_pro(tol_r);
|
||||
}
|
||||
|
||||
j_w = ((j_w + 1) & 15);
|
||||
}
|
||||
while ( j_w != i_w );
|
||||
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
lot_r = u2_slot_b_sid_i(lot_r, i_w);
|
||||
sif_w += 4;
|
||||
goto top;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_cs_find():
|
||||
**
|
||||
** Find `sam` for `sel`, or return `u2_none`.
|
||||
*/
|
||||
u2_weak // retain
|
||||
u2_cs_find(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
u2_noun sam) // retain
|
||||
{
|
||||
c3_w key_w = u2_mug(sel_m) ^ u2_mug(sam);
|
||||
|
||||
return _cs_find_1(ral_r, lot_r, key_w, 0, sel_m, sam);
|
||||
}
|
||||
|
||||
/* u2_cs_find_cell():
|
||||
**
|
||||
** Find `[a b]` for `sel`, or return `u2_none`.
|
||||
*/
|
||||
u2_weak // retain
|
||||
u2_cs_find_cell(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
c3_w key_w = u2_mug(sel_m) ^ u2_mug_cell(a, b);
|
||||
|
||||
return _cs_find_2(ral_r, lot_r, key_w, 0, sel_m, a, b);
|
||||
}
|
||||
|
||||
/* u2_cs_find_mixt():
|
||||
**
|
||||
** Find `[a b]` for `sel`, or return `u2_none`.
|
||||
*/
|
||||
u2_weak // retain
|
||||
u2_cs_find_mixt(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
const c3_c* a_c, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
c3_w mug_w = u2_mug_both(u2_mug_string(a_c), u2_mug(b));
|
||||
c3_w key_w = u2_mug(sel_m) ^ mug_w;
|
||||
|
||||
return _cs_find_2m(ral_r, lot_r, key_w, 0, sel_m, a_c, b);
|
||||
}
|
||||
|
||||
/* u2_cs_find_trel():
|
||||
**
|
||||
** Find `[a b]` for `sel`, or return `u2_none`.
|
||||
*/
|
||||
u2_weak // retain
|
||||
u2_cs_find_trel(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
u2_noun a, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun c) // retain
|
||||
{
|
||||
c3_w key_w = u2_mug(sel_m) ^ u2_mug_trel(a, b, c);
|
||||
|
||||
return _cs_find_3(ral_r, lot_r, key_w, 0, sel_m, a, b, c);
|
||||
}
|
||||
|
||||
/* u2_cs_find_qual():
|
||||
**
|
||||
** Find `[a b]` for `sel`, or return `u2_none`.
|
||||
*/
|
||||
u2_weak // retain
|
||||
u2_cs_find_qual(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
u2_noun a, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun c, // retain
|
||||
u2_noun d) // retain
|
||||
{
|
||||
c3_w key_w = u2_mug(sel_m) ^ u2_mug_qual(a, b, c, d);
|
||||
|
||||
return _cs_find_4(ral_r, lot_r, key_w, 0, sel_m, a, b, c, d);
|
||||
}
|
||||
|
||||
/* _cs_save_c(): add to slot of type c.
|
||||
*/
|
||||
static u2_bean
|
||||
_cs_save_c(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
u2_noun sap, // retain
|
||||
u2_noun pro) // retain
|
||||
{
|
||||
u2_slot_a_sel(lot_r) = sel_m;
|
||||
u2_slot_a_sap(lot_r) = u2_rx(ral_r, sap);
|
||||
u2_slot_a_pro(lot_r) = u2_rx(ral_r, pro);
|
||||
|
||||
return u2_yes;
|
||||
}
|
||||
|
||||
/* _cs_more_b(): convert slot of type b from collision to radix.
|
||||
*/
|
||||
static void
|
||||
_cs_more_b(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_w sif_w)
|
||||
{
|
||||
u2_ray dis_r = u2_rl_ralloc(ral_r, (16 * c3_wiseof(u2_cash_slot_a)));
|
||||
u2_ray sid_r = u2_slot_b_sid(lot_r);
|
||||
c3_w i_w;
|
||||
|
||||
if ( 0 == dis_r ) {
|
||||
return;
|
||||
}
|
||||
u2_slot_b_gun(lot_r) = u2_slot_gunk_radx;
|
||||
u2_slot_b_rag(lot_r) = 0;
|
||||
u2_slot_b_sid(lot_r) = dis_r;
|
||||
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray tol_r = (dis_r + ((i_w) * c3_wiseof(u2_cash_slot_a)));
|
||||
|
||||
u2_slot_c_emt(tol_r) = u2_slot_emty;
|
||||
}
|
||||
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray tol_r = (sid_r + ((i_w) * c3_wiseof(u2_cash_slot_a)));
|
||||
|
||||
if ( u2_slot_is_a(tol_r) ) {
|
||||
c3_m sel_m = u2_slot_a_sel(tol_r);
|
||||
u2_noun sap = u2_slot_a_sap(tol_r);
|
||||
u2_noun pro = u2_slot_a_pro(tol_r);
|
||||
c3_w key_w = u2_mug(sel_m) ^ u2_mug(u2_h(sap));
|
||||
|
||||
_cs_save_b(ral_r, lot_r, key_w, sif_w, sel_m, sap, pro);
|
||||
|
||||
u2_rz(ral_r, sap);
|
||||
u2_rz(ral_r, pro);
|
||||
}
|
||||
}
|
||||
u2_rl_rfree(ral_r, sid_r);
|
||||
}
|
||||
|
||||
/* _cs_save_b(): add to slot of type b.
|
||||
*/
|
||||
static u2_bean
|
||||
_cs_save_b(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_w key_w,
|
||||
c3_w sif_w,
|
||||
c3_m sel_m,
|
||||
u2_noun sap, // retain
|
||||
u2_noun pro) // retain
|
||||
{
|
||||
top: {
|
||||
c3_w gun_w = u2_slot_b_gun(lot_r);
|
||||
c3_w i_w = (key_w >> sif_w) & 15;
|
||||
|
||||
if ( u2_slot_gunk_is_coll(gun_w) ) {
|
||||
if ( (u2_slot_b_rag(lot_r) >= u2_tune_cash_hi) &&
|
||||
(sif_w != 32) )
|
||||
{
|
||||
_cs_more_b(ral_r, lot_r, sif_w);
|
||||
goto top;
|
||||
}
|
||||
else {
|
||||
c3_w j_w = i_w;
|
||||
|
||||
do {
|
||||
u2_ray tol_r = u2_slot_b_sid_i(lot_r, j_w);
|
||||
|
||||
if ( u2_slot_is_a(tol_r) ) {
|
||||
if ( (sel_m == u2_slot_a_sel(tol_r)) &&
|
||||
(u2_yes == _cs_find_sap(ral_r, tol_r, u2_h(sap))) )
|
||||
{
|
||||
if ( u2_no == u2_sing(pro, u2_slot_a_pro(tol_r)) ) {
|
||||
u2_rz(ral_r, u2_slot_a_pro(tol_r));
|
||||
u2_slot_a_pro(tol_r) = u2_rx(ral_r, pro);
|
||||
}
|
||||
return u2_no;
|
||||
}
|
||||
}
|
||||
else if ( u2_slot_is_c(tol_r) ) {
|
||||
u2_slot_b_rag(lot_r) += 1;
|
||||
|
||||
return _cs_save_c(ral_r, tol_r, sel_m, sap, pro);
|
||||
}
|
||||
j_w = ((j_w + 1) & 15);
|
||||
}
|
||||
while ( j_w != i_w );
|
||||
|
||||
return u2_no;
|
||||
}
|
||||
} else {
|
||||
u2_bean ave = _cs_save_in(ral_r,
|
||||
u2_slot_b_sid_i(lot_r, i_w),
|
||||
key_w,
|
||||
(sif_w + 4),
|
||||
sel_m, sap, pro);
|
||||
if ( u2_yes == ave ) {
|
||||
u2_slot_b_rag(lot_r) += 1;
|
||||
}
|
||||
return ave;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cs_save_a(): add to slot of type a.
|
||||
*/
|
||||
static u2_bean
|
||||
_cs_save_a(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_w key_w,
|
||||
c3_w sif_w,
|
||||
c3_m sel_m,
|
||||
u2_noun sap, // retain
|
||||
u2_noun pro) // retain
|
||||
{
|
||||
if ( (sel_m == u2_slot_a_sel(lot_r)) &&
|
||||
(u2_yes == _cs_find_sap(ral_r, lot_r, u2_h(sap)) ) )
|
||||
{
|
||||
if ( u2_no == u2_sing(pro, u2_slot_a_pro(lot_r)) ) {
|
||||
u2_rz(ral_r, u2_slot_a_pro(lot_r));
|
||||
u2_slot_a_pro(lot_r) = u2_rx(ral_r, pro);
|
||||
}
|
||||
return u2_no;
|
||||
} else {
|
||||
u2_noun sid_r = u2_rl_ralloc(ral_r, 16 * c3_wiseof(u2_cash_slot_a));
|
||||
|
||||
if ( 0 == sid_r ) {
|
||||
return u2_no;
|
||||
} else {
|
||||
c3_m lus_m = u2_slot_a_sel(lot_r);
|
||||
u2_noun pes = u2_slot_a_sap(lot_r);
|
||||
u2_noun rop = u2_slot_a_pro(lot_r);
|
||||
c3_w yek_w = u2_mug(lus_m) ^ u2_mug(u2_h(pes));
|
||||
u2_bean ave;
|
||||
|
||||
u2_slot_b_gun(lot_r) = u2_slot_gunk_coll;
|
||||
u2_slot_b_rag(lot_r) = 0;
|
||||
u2_slot_b_sid(lot_r) = sid_r;
|
||||
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray tol_r = u2_slot_b_sid_i(lot_r, i_w);
|
||||
|
||||
u2_slot_c_emt(tol_r) = u2_slot_emty;
|
||||
u2_slot_b_rag(tol_r) = 0;
|
||||
u2_slot_b_sid(tol_r) = 0;
|
||||
}
|
||||
}
|
||||
|
||||
{
|
||||
ave = _cs_save_b(ral_r, lot_r, yek_w, sif_w, lus_m, pes, rop);
|
||||
c3_assert(u2_yes == ave);
|
||||
|
||||
u2_rz(ral_r, pes);
|
||||
u2_rz(ral_r, rop);
|
||||
}
|
||||
|
||||
return _cs_save_b(ral_r, lot_r, key_w, sif_w, sel_m, sap, pro);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cs_save_in():
|
||||
**
|
||||
** As u2_cs_save(), but `u2_yes` iff table adds a sample.
|
||||
*/
|
||||
static u2_bean
|
||||
_cs_save_in(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_w key_w,
|
||||
c3_w sif_w,
|
||||
c3_m sel_m,
|
||||
u2_noun sap, // retain
|
||||
u2_noun pro) // retain
|
||||
{
|
||||
if ( u2_slot_is_a(lot_r) ) {
|
||||
return _cs_save_a(ral_r, lot_r, key_w, sif_w, sel_m, sap, pro);
|
||||
}
|
||||
else if ( u2_slot_is_b(lot_r) ) {
|
||||
return _cs_save_b(ral_r, lot_r, key_w, sif_w, sel_m, sap, pro);
|
||||
}
|
||||
else {
|
||||
return _cs_save_c(ral_r, lot_r, sel_m, sap, pro);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_cs_save():
|
||||
**
|
||||
** Save `sam` as `pro` for `sel`. Replace existing `pro`, if any.
|
||||
*/
|
||||
u2_noun // transfer
|
||||
u2_cs_save(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
u2_noun sam, // retain
|
||||
u2_noun pro) // transfer
|
||||
{
|
||||
c3_w key_w = u2_mug(sel_m) ^ u2_mug(sam);
|
||||
c3_w sif_w = 0;
|
||||
u2_noun sap = u2_rc(ral_r, u2_rx(ral_r, sam), u2_nul);
|
||||
|
||||
_cs_save_in(ral_r, lot_r, key_w, sif_w, sel_m, sap, pro);
|
||||
|
||||
u2_rz(ral_r, sap);
|
||||
return pro;
|
||||
}
|
||||
|
||||
/* u2_cs_save_mixt():
|
||||
**
|
||||
** Save `[a b]` as `pro` for `sel`.
|
||||
*/
|
||||
u2_noun // transfer
|
||||
u2_cs_save_mixt(u2_ray ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
const c3_c* a_c, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun pro) // transfer
|
||||
{
|
||||
u2_noun sam = u2_rc(ral_r, u2_rl_string(ral_r, a_c), u2_rx(ral_r, b));
|
||||
u2_noun ret = u2_cs_save(ral_r, lot_r, sel_m, sam, pro);
|
||||
|
||||
u2_rz(ral_r, sam);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* u2_cs_save_cell():
|
||||
**
|
||||
** Save `[a b]` as `pro` for `sel`.
|
||||
*/
|
||||
u2_noun // transfer
|
||||
u2_cs_save_cell(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
u2_noun a, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun pro) // transfer
|
||||
{
|
||||
u2_noun sam = u2_rc(ral_r, u2_rx(ral_r, a), u2_rx(ral_r, b));
|
||||
u2_noun ret = u2_cs_save(ral_r, lot_r, sel_m, sam, pro);
|
||||
|
||||
u2_rz(ral_r, sam);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* u2_cs_save_trel():
|
||||
**
|
||||
** Save `[a b c]` as `pro` for `sel`.
|
||||
*/
|
||||
u2_noun // transfer
|
||||
u2_cs_save_trel(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
u2_noun a, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun c, // retain
|
||||
u2_noun pro) // transfer
|
||||
{
|
||||
u2_noun sam = u2_rt(ral_r, u2_rx(ral_r, a), u2_rx(ral_r, b), u2_rx(ral_r, c));
|
||||
u2_noun ret = u2_cs_save(ral_r, lot_r, sel_m, sam, pro);
|
||||
|
||||
u2_rz(ral_r, sam);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* u2_cs_save_qual():
|
||||
**
|
||||
** Save `[a b c d]` as `pro` for `sel`.
|
||||
*/
|
||||
u2_noun // transfer
|
||||
u2_cs_save_qual(u2_rail ral_r,
|
||||
u2_ray lot_r,
|
||||
c3_m sel_m,
|
||||
u2_noun a, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun c, // retain
|
||||
u2_noun d, // retain
|
||||
u2_noun pro) // transfer
|
||||
{
|
||||
u2_noun sam = u2_rq(ral_r, u2_rx(ral_r, a),
|
||||
u2_rx(ral_r, b),
|
||||
u2_rx(ral_r, c),
|
||||
u2_rx(ral_r, d));
|
||||
u2_noun ret = u2_cs_save(ral_r, lot_r, sel_m, sam, pro);
|
||||
|
||||
u2_rz(ral_r, sam);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* u2_cs_free():
|
||||
**
|
||||
** Release an old hashtable.
|
||||
*/
|
||||
void
|
||||
u2_cs_free(u2_rail ral_r,
|
||||
u2_ray lot_r) // submit
|
||||
{
|
||||
u2_cs_lose(ral_r, lot_r);
|
||||
u2_rl_rfree(ral_r, lot_r);
|
||||
}
|
||||
|
||||
/* u2_cs_mark():
|
||||
**
|
||||
** Mark traverse of slot.
|
||||
*/
|
||||
c3_w
|
||||
u2_cs_mark(u2_ray ral_r,
|
||||
u2_ray lot_r)
|
||||
{
|
||||
c3_w siz_w = 0;
|
||||
|
||||
if ( u2_slot_is_a(lot_r) ) {
|
||||
siz_w += u2_rl_gc_mark_noun(ral_r, u2_slot_a_sap(lot_r));
|
||||
siz_w += u2_rl_gc_mark_noun(ral_r, u2_slot_a_pro(lot_r));
|
||||
}
|
||||
else if ( u2_slot_is_b(lot_r) ) {
|
||||
u2_ray sid_r = u2_slot_b_sid(lot_r);
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray tol_r = (sid_r + ((i_w) * c3_wiseof(u2_cash_slot_a)));
|
||||
|
||||
siz_w += u2_cs_mark(ral_r, tol_r);
|
||||
}
|
||||
siz_w += u2_rl_gc_mark_ptr(ral_r, sid_r);
|
||||
}
|
||||
return siz_w;
|
||||
}
|
||||
|
||||
/* u2_cs_init():
|
||||
**
|
||||
** Initialize slot to empty.
|
||||
*/
|
||||
void
|
||||
u2_cs_init(u2_ray lot_r)
|
||||
{
|
||||
u2_slot_c_emt(lot_r) = u2_slot_emty;
|
||||
}
|
||||
|
||||
/* u2_cs_lose():
|
||||
**
|
||||
** Release all resources in and under slot (but not slot itself).
|
||||
*/
|
||||
void
|
||||
u2_cs_lose(u2_rail ral_r,
|
||||
u2_ray lot_r) // submit
|
||||
{
|
||||
if ( u2_slot_is_a(lot_r) ) {
|
||||
u2_rz(ral_r, u2_slot_a_sap(lot_r));
|
||||
u2_rz(ral_r, u2_slot_a_pro(lot_r));
|
||||
}
|
||||
else if ( u2_slot_is_b(lot_r) ) {
|
||||
u2_ray sid_r = u2_slot_b_sid(lot_r);
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray tol_r = (sid_r + ((i_w) * c3_wiseof(u2_cash_slot_a)));
|
||||
|
||||
u2_cs_lose(ral_r, tol_r);
|
||||
}
|
||||
u2_rl_rfree(ral_r, sid_r);
|
||||
}
|
||||
u2_cs_init(lot_r);
|
||||
c3_assert(u2_slot_is_c(lot_r));
|
||||
}
|
||||
|
||||
/* u2_cs_make():
|
||||
**
|
||||
** Create a new hashtable.
|
||||
*/
|
||||
u2_ray // produce
|
||||
u2_cs_make(u2_rail ral_r)
|
||||
{
|
||||
u2_ray lot_r = u2_rl_ralloc(ral_r, c3_wiseof(u2_cash_slot_a));
|
||||
|
||||
if ( 0 == lot_r ) {
|
||||
return 0;
|
||||
} else {
|
||||
u2_cs_init(lot_r);
|
||||
return lot_r;
|
||||
}
|
||||
}
|
||||
372
f/chad.c
372
f/chad.c
@ -1,372 +0,0 @@
|
||||
/* f/chad.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* u2_ch_init():
|
||||
**
|
||||
** Initialize empty chad.
|
||||
*/
|
||||
void
|
||||
u2_ch_init(u2_ray cad_r)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray per_r = (cad_r + (c3_wiseof(u2_loom_pear) * i_w));
|
||||
|
||||
*u2_at(per_r, u2_loom_pear, nam) = u2_none;
|
||||
*u2_at(per_r, u2_loom_pear, val) = 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ch_find():
|
||||
**
|
||||
** Find value for `nam` in `cad`, or return `u2_none`.
|
||||
*/
|
||||
u2_weak
|
||||
u2_ch_find(u2_ray cad_r,
|
||||
u2_noun nam)
|
||||
{
|
||||
c3_w mug_w = u2_mug(nam);
|
||||
c3_w off_w = 0;
|
||||
|
||||
while ( 1 ) {
|
||||
if ( off_w == 32 ) {
|
||||
/* Linear search in a list of 16 total collisions.
|
||||
** Overflow probability: (n/(2^31))^15 ~= 0.
|
||||
*/
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray per_r = (cad_r + (c3_wiseof(u2_loom_pear) * i_w));
|
||||
u2_noun nom = *u2_at(per_r, u2_loom_pear, nam);
|
||||
|
||||
if ( (u2_none != nom) && (u2_yes == u2_sing(nam, nom)) ) {
|
||||
return *u2_at(per_r, u2_loom_pear, val);
|
||||
}
|
||||
}
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
c3_w fat_w = (mug_w >> off_w) & 15;
|
||||
u2_ray per_r = (cad_r + (c3_wiseof(u2_loom_pear) * fat_w));
|
||||
u2_noun nom = *u2_at(per_r, u2_loom_pear, nam);
|
||||
|
||||
if ( u2_none == nom ) {
|
||||
cad_r = *u2_at(per_r, u2_loom_pear, val);
|
||||
|
||||
if ( 0 == cad_r ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
off_w += 4;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
else if ( u2_yes == u2_sing(nam, nom) ) {
|
||||
return *u2_at(per_r, u2_loom_pear, val);
|
||||
}
|
||||
else return u2_none;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
u2_b_print(const c3_c* cap_c, u2_noun som);
|
||||
|
||||
/* u2_ch_find_cell():
|
||||
**
|
||||
** Find value for `[hed tal]` in `cad`, or return `u2_none`.
|
||||
*/
|
||||
u2_weak
|
||||
u2_ch_find_cell(u2_ray cad_r,
|
||||
u2_noun hed,
|
||||
u2_noun tal)
|
||||
{
|
||||
c3_w mug_w = u2_mug_cell(hed, tal);
|
||||
c3_w off_w = 0;
|
||||
|
||||
while ( 1 ) {
|
||||
if ( off_w == 32 ) {
|
||||
/* Linear search in a list of 16 total collisions.
|
||||
** Overflow probability: (n/(2^31))^15 ~= 0.
|
||||
*/
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray per_r = (cad_r + (c3_wiseof(u2_loom_pear) * i_w));
|
||||
u2_noun nom = *u2_at(per_r, u2_loom_pear, nam);
|
||||
|
||||
if ( u2_none != nom ) {
|
||||
if ( (u2_yes == u2_dust(nom)) &&
|
||||
(u2_yes == u2_sing(hed, u2_h(nom))) &&
|
||||
(u2_yes == u2_sing(tal, u2_t(nom))) )
|
||||
{
|
||||
return *u2_at(per_r, u2_loom_pear, val);
|
||||
}
|
||||
}
|
||||
}
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
c3_w fat_w = (mug_w >> off_w) & 15;
|
||||
u2_ray per_r = (cad_r + (c3_wiseof(u2_loom_pear )* fat_w));
|
||||
u2_noun nom = *u2_at(per_r, u2_loom_pear, nam);
|
||||
|
||||
if ( u2_none == nom ) {
|
||||
cad_r = *u2_at(per_r, u2_loom_pear, val);
|
||||
|
||||
if ( 0 == cad_r ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
off_w += 4;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
else if ( u2_yes == u2_dust(nom) &&
|
||||
(u2_yes == u2_sing(hed, u2_h(nom))) &&
|
||||
(u2_yes == u2_sing(tal, u2_t(nom))) )
|
||||
{
|
||||
return *u2_at(per_r, u2_loom_pear, val);
|
||||
}
|
||||
else {
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ch_find_mixt():
|
||||
**
|
||||
** Find value for `[hed tal]` in `cad`, or return `u2_none`.
|
||||
*/
|
||||
u2_weak
|
||||
u2_ch_find_mixt(u2_ray cad_r,
|
||||
const c3_c* hed_c,
|
||||
u2_noun tal)
|
||||
{
|
||||
c3_w mug_w = u2_mug_both(u2_mug_string(hed_c), u2_mug(tal));
|
||||
c3_w off_w = 0;
|
||||
|
||||
while ( 1 ) {
|
||||
if ( off_w == 32 ) {
|
||||
/* Linear search in a list of 16 total collisions.
|
||||
** Overflow probability: (n/(2^31))^15 ~= 0.
|
||||
*/
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray per_r = (cad_r + (c3_wiseof(u2_loom_pear) * i_w));
|
||||
u2_noun nom = *u2_at(per_r, u2_loom_pear, nam);
|
||||
|
||||
if ( u2_none != nom ) {
|
||||
if ( (u2_yes == u2_dust(nom)) &&
|
||||
(u2_yes == u2_sing_c(hed_c, u2_h(nom))) &&
|
||||
(u2_yes == u2_sing(tal, u2_t(nom))) )
|
||||
{
|
||||
return *u2_at(per_r, u2_loom_pear, val);
|
||||
}
|
||||
}
|
||||
}
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
c3_w fat_w = (mug_w >> off_w) & 15;
|
||||
u2_ray per_r = (cad_r + (c3_wiseof(u2_loom_pear )* fat_w));
|
||||
u2_noun nom = *u2_at(per_r, u2_loom_pear, nam);
|
||||
|
||||
if ( u2_none == nom ) {
|
||||
cad_r = *u2_at(per_r, u2_loom_pear, val);
|
||||
|
||||
if ( 0 == cad_r ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
off_w += 4;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
else if ( u2_yes == u2_dust(nom) &&
|
||||
(u2_yes == u2_sing_c(hed_c, u2_h(nom))) &&
|
||||
(u2_yes == u2_sing(tal, u2_t(nom))) )
|
||||
{
|
||||
return *u2_at(per_r, u2_loom_pear, val);
|
||||
}
|
||||
else {
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _ch_save(): as u2_ch_save(), with mug and offset, and iced nouns.
|
||||
*/
|
||||
static u2_bean
|
||||
_ch_save(u2_ray ral_r,
|
||||
u2_ray cad_r,
|
||||
u2_noun nim,
|
||||
u2_noun vil,
|
||||
c3_w mug_w,
|
||||
c3_w off_w)
|
||||
{
|
||||
while ( 1 ) {
|
||||
if ( off_w == 32 ) {
|
||||
/* Linear search in a list of 16 total collisions.
|
||||
** Overflow probability: (n/(2^31))^15 ~= 0.
|
||||
*/
|
||||
c3_w i_w;
|
||||
|
||||
// printf("conflict: %x\n", mug_w);
|
||||
for ( i_w = 0; i_w < 16; i_w++ ) {
|
||||
u2_ray per_r = (cad_r + (c3_wiseof(u2_loom_pear) * i_w));
|
||||
u2_noun nom = *u2_at(per_r, u2_loom_pear, nam);
|
||||
|
||||
if ( u2_none != nom ) {
|
||||
c3_assert(u2_no == u2_sing(nim, nom));
|
||||
}
|
||||
else {
|
||||
*u2_at(per_r, u2_loom_pear, nam) = nim;
|
||||
*u2_at(per_r, u2_loom_pear, val) = vil;
|
||||
return u2_yes;
|
||||
}
|
||||
}
|
||||
return u2_no;
|
||||
}
|
||||
else {
|
||||
c3_w fat_w = (mug_w >> off_w) & 15;
|
||||
u2_ray per_r = (cad_r + (c3_wiseof(u2_loom_pear) * fat_w));
|
||||
u2_noun nom = *u2_at(per_r, u2_loom_pear, nam);
|
||||
|
||||
if ( u2_none == nom ) {
|
||||
cad_r = *u2_at(per_r, u2_loom_pear, val);
|
||||
|
||||
if ( 0 == cad_r ) {
|
||||
*u2_at(per_r, u2_loom_pear, nam) = nim;
|
||||
*u2_at(per_r, u2_loom_pear, val) = vil;
|
||||
return u2_yes;
|
||||
}
|
||||
else {
|
||||
off_w += 4;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
else {
|
||||
u2_noun vol = *u2_at(per_r, u2_loom_pear, val);
|
||||
u2_ray osh_r;
|
||||
|
||||
if ( 0 == (osh_r = u2_rl_ralloc(ral_r, c3_wiseof(u2_loom_chad))) ) {
|
||||
return u2_no;
|
||||
}
|
||||
u2_ch_init(osh_r);
|
||||
|
||||
if ( u2_no == _ch_save(ral_r, osh_r, nom, vol, u2_mug(nom), 4+off_w) ) {
|
||||
u2_rl_rfree(ral_r, osh_r);
|
||||
return u2_no;
|
||||
}
|
||||
if ( u2_no == _ch_save(ral_r, osh_r, nim, vil, mug_w, 4+off_w) ) {
|
||||
u2_rl_rfree(ral_r, osh_r);
|
||||
return u2_no;
|
||||
}
|
||||
*u2_at(per_r, u2_loom_pear, nam) = u2_none;
|
||||
*u2_at(per_r, u2_loom_pear, val) = osh_r;
|
||||
return u2_yes;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ch_save():
|
||||
**
|
||||
** Save `val` under `nam` in `cad`, allocating in `ral`.
|
||||
** Return `u2_none` iff allocation fails. Asserts on duplicate.
|
||||
**
|
||||
** Caller retains arguments; callee retains result.
|
||||
*/
|
||||
u2_weak
|
||||
u2_ch_save(u2_ray ral_r,
|
||||
u2_ray cad_r,
|
||||
u2_noun nam,
|
||||
u2_noun val)
|
||||
{
|
||||
u2_weak nim, vil;
|
||||
|
||||
if ( u2_none == (nim = u2_rl_ice(ral_r, nam)) ) {
|
||||
return u2_none;
|
||||
}
|
||||
if ( u2_none == (vil = u2_rl_ice(ral_r, val)) ) {
|
||||
u2_rl_lose(ral_r, nim);
|
||||
return u2_none;
|
||||
}
|
||||
if ( u2_no == _ch_save(ral_r, cad_r, nim, vil, u2_mug(nim), 0) ) {
|
||||
u2_rl_lose(ral_r, nim);
|
||||
u2_rl_lose(ral_r, vil);
|
||||
return u2_none;
|
||||
}
|
||||
return vil;
|
||||
}
|
||||
|
||||
/* u2_ch_save_cell():
|
||||
**
|
||||
** Save `val` under `[hed tal]` in `cad`, allocating in `ral`.
|
||||
** Return `u2_none` iff allocation fails. Asserts on duplicate.
|
||||
**
|
||||
** Caller retains arguments; callee retains result.
|
||||
*/
|
||||
u2_weak
|
||||
u2_ch_save_cell(u2_ray ral_r,
|
||||
u2_ray cad_r,
|
||||
u2_noun hed,
|
||||
u2_noun tal,
|
||||
u2_noun val)
|
||||
{
|
||||
u2_weak nim, vil;
|
||||
|
||||
if ( u2_none == (nim = u2_rl_cell(ral_r, u2_rl_ice(ral_r, hed),
|
||||
u2_rl_ice(ral_r, tal))) )
|
||||
{
|
||||
return u2_none;
|
||||
}
|
||||
if ( u2_none == (vil = u2_rl_ice(ral_r, val)) ) {
|
||||
u2_rl_lose(ral_r, nim);
|
||||
return u2_none;
|
||||
}
|
||||
if ( u2_no == _ch_save(ral_r, cad_r, nim, vil, u2_mug(nim), 0) ) {
|
||||
u2_rl_lose(ral_r, nim);
|
||||
u2_rl_lose(ral_r, vil);
|
||||
return u2_none;
|
||||
}
|
||||
return vil;
|
||||
}
|
||||
|
||||
/* u2_ch_save_mixt():
|
||||
**
|
||||
** Save `val` under `[hed tal]` in `cad`, allocating in `ral`.
|
||||
** Return `u2_none` iff allocation fails. Asserts on duplicate.
|
||||
**
|
||||
** Caller retains ownership of arguments; callee retains result.
|
||||
*/
|
||||
u2_weak
|
||||
u2_ch_save_mixt(u2_ray ral_r,
|
||||
u2_ray cad_r,
|
||||
const c3_c* hed_c,
|
||||
u2_noun tal,
|
||||
u2_noun val)
|
||||
{
|
||||
u2_weak nim, vil;
|
||||
|
||||
if ( u2_none == (nim = u2_rl_cell(ral_r, u2_rl_string(ral_r, hed_c),
|
||||
u2_rl_ice(ral_r, tal))) )
|
||||
{
|
||||
return u2_none;
|
||||
}
|
||||
if ( u2_none == (vil = u2_rl_ice(ral_r, val)) ) {
|
||||
u2_rl_lose(ral_r, nim);
|
||||
return u2_none;
|
||||
}
|
||||
if ( u2_no == _ch_save(ral_r, cad_r, nim, vil, u2_mug(nim), 0) ) {
|
||||
u2_rl_lose(ral_r, nim);
|
||||
u2_rl_lose(ral_r, vil);
|
||||
return u2_none;
|
||||
}
|
||||
return vil;
|
||||
}
|
||||
990
f/coal.c
990
f/coal.c
@ -1,990 +0,0 @@
|
||||
/* 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_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;
|
||||
}
|
||||
419
f/dash.c
419
f/dash.c
@ -1,419 +0,0 @@
|
||||
/* f/dash.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* _ds_mate(): u2_yes iff `xip` binds to `cor`.
|
||||
*/
|
||||
static u2_bean
|
||||
_ds_mate(u2_noun xip, // retain
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun dac, bat, pet;
|
||||
|
||||
u2_as_trel(xip, &dac, &bat, &pet);
|
||||
|
||||
// Very important for performance that we mate top-down.
|
||||
// Reason: duplicates are much more common in shallower
|
||||
// batteries, and duplicate comparison is always slow.
|
||||
//
|
||||
if ( u2_nul != pet ) {
|
||||
u2_noun axe = u2_h(pet);
|
||||
u2_noun led = u2_t(pet);
|
||||
u2_noun ruc = u2_frag(axe, cor);
|
||||
|
||||
if ( (u2_none == ruc) || (u2_no == _ds_mate(led, ruc)) ) {
|
||||
return u2_no;
|
||||
}
|
||||
}
|
||||
|
||||
return u2_sing(bat, u2_h(cor));
|
||||
}
|
||||
|
||||
/* _ds_scan(): linear search for matching chip.
|
||||
*/
|
||||
static u2_noun // discover
|
||||
_ds_scan(u2_noun pug, // retain
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
while ( u2_nul != pug ) {
|
||||
u2_noun i_pug = u2_h(pug);
|
||||
|
||||
if ( u2_yes == _ds_mate(i_pug, cor) ) {
|
||||
return i_pug;
|
||||
}
|
||||
pug = u2_t(pug);
|
||||
}
|
||||
return u2_none;
|
||||
}
|
||||
|
||||
/* u2_ds_find(): find chip by core, or none.
|
||||
*/
|
||||
u2_weak // senior
|
||||
u2_ds_find(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
if ( u2_no == u2_dust(cor) ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
u2_rail bas_r = u2_wire_bas_r(wir_r);
|
||||
u2_noun pug = u2_cs_find(bas_r, u2_wire_des_r(wir_r), 0, u2_h(cor));
|
||||
u2_noun out;
|
||||
|
||||
if ( u2_none == pug ) {
|
||||
out = u2_none;
|
||||
}
|
||||
else out = _ds_scan(pug, cor);
|
||||
|
||||
#if 0
|
||||
if ( (u2_none == out) && (u2_none != pug) ) {
|
||||
fprintf(stderr, "half match\r\n");
|
||||
}
|
||||
#endif
|
||||
return out;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ds_good_cop()::
|
||||
*/
|
||||
static u2_bean
|
||||
_ds_good_cop(u2_noun cop)
|
||||
{
|
||||
c3_w i_w = 0;
|
||||
|
||||
while ( i_w < 4 ) {
|
||||
if ( u2_yes == u2_stud(cop) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
if ( u2_no == u2_stud(u2_h(cop)) ) {
|
||||
return u2_no;
|
||||
}
|
||||
cop = u2_t(cop);
|
||||
i_w++;
|
||||
}
|
||||
return u2_no;
|
||||
}
|
||||
|
||||
/* _ds_good_bud()::
|
||||
*/
|
||||
static u2_bean
|
||||
_ds_good_bud(u2_noun bud)
|
||||
{
|
||||
u2_noun p_bud, q_bud;
|
||||
|
||||
if ( _0 == bud ) {
|
||||
return u2_yes;
|
||||
}
|
||||
else if ( (u2_no == u2_as_cell(bud, &p_bud, &q_bud)) ) {
|
||||
return u2_no;
|
||||
}
|
||||
if ( (u2_nock_bone == p_bud) && (_0 == q_bud) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
if ( (u2_nock_frag == p_bud) && (u2_yes == u2_stud(q_bud)) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
if ( u2_nock_hint == p_bud ) {
|
||||
return u2_yes == u2_dust(u2_t(bud)) ? _ds_good_bud(u2_t(u2_t(bud))) : u2_no;
|
||||
}
|
||||
else return u2_no;
|
||||
}
|
||||
|
||||
/* _ds_good_pic()::
|
||||
*/
|
||||
static u2_bean
|
||||
_ds_good_pic(u2_noun pic)
|
||||
{
|
||||
if ( u2_nul == pic ) {
|
||||
return u2_yes;
|
||||
} else {
|
||||
u2_noun i_pic, t_pic;
|
||||
u2_noun pi_pic, qi_pic;
|
||||
|
||||
if ( (u2_no == u2_as_cell(pic, &i_pic, &t_pic)) ||
|
||||
(u2_no == u2_as_cell(i_pic, &pi_pic, &qi_pic)) ||
|
||||
(u2_no == u2_stud(pi_pic)) )
|
||||
{
|
||||
return u2_no;
|
||||
}
|
||||
else return u2_yes;
|
||||
}
|
||||
}
|
||||
|
||||
extern void u2_lo_show(c3_c* cap_c, u2_noun nun);
|
||||
|
||||
/* _ds_chip(): fabricate chip from clue and core.
|
||||
*/
|
||||
static u2_weak // senior
|
||||
_ds_chip(u2_wire wir_r,
|
||||
u2_noun clu, // retain
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_rail bas_r = u2_wire_bas_r(wir_r);
|
||||
u2_noun bud_clu, cop_clu, pic_clu;
|
||||
|
||||
if ( (u2_no == u2_as_trel(clu, &bud_clu, &cop_clu, &pic_clu)) ||
|
||||
(u2_no == _ds_good_bud(bud_clu)) ||
|
||||
(u2_no == _ds_good_cop(cop_clu)) ||
|
||||
(u2_no == _ds_good_pic(pic_clu)) )
|
||||
{
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
u2_noun dac, bat, pet;
|
||||
|
||||
/* disc: dac
|
||||
*/
|
||||
{
|
||||
if ( u2_none == (dac = u2_rx(bas_r, u2_t(clu))) ) {
|
||||
u2_ho_warn_here();
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
#if 1
|
||||
/* battery: bat
|
||||
*/
|
||||
{
|
||||
if ( u2_none == (bat = u2_rx(bas_r, u2_h(cor))) ) {
|
||||
u2_ho_warn_here();
|
||||
u2_rz(bas_r, dac); return u2_none;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
#if 0
|
||||
/* bat: battery
|
||||
*/
|
||||
{
|
||||
// Important to reuse existing battery even if it does not match
|
||||
// the whole chip - since battery is a comparison key, we don't
|
||||
// want duplicates, which compare slowly.
|
||||
//
|
||||
if ( u2_nul == pug ) {
|
||||
bat = u2_rx(bas_r, u2_h(cor));
|
||||
}
|
||||
else {
|
||||
u2_noun i_pug = u2_h(pug);
|
||||
bat = u2_rx(bas_r, u2_h(u2_t(i_pug)));
|
||||
}
|
||||
|
||||
if ( u2_none == bat ) {
|
||||
u2_ho_warn_here();
|
||||
u2_rz(bas_r, dac); return u2_none;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
/* trunk: pet
|
||||
*/
|
||||
{
|
||||
if ( _0 == bud_clu ) {
|
||||
pet = u2_nul;
|
||||
}
|
||||
else {
|
||||
while ( _10 == u2_h(bud_clu) ) {
|
||||
bud_clu = u2_t(u2_t(bud_clu));
|
||||
}
|
||||
|
||||
if ( _1 == u2_h(bud_clu) ) {
|
||||
pet = u2_nul;
|
||||
}
|
||||
else {
|
||||
u2_atom axe = u2_t(bud_clu);
|
||||
u2_noun ruc = u2_frag(axe, cor);
|
||||
u2_noun led;
|
||||
|
||||
if ( u2_none == ruc ) {
|
||||
// u2_err(wir_r, "clu", clu);
|
||||
u2_ho_warn_here();
|
||||
u2_rz(bas_r, dac); u2_rz(bas_r, bat); return u2_none;
|
||||
} else {
|
||||
if ( u2_none == (led = u2_ds_find(wir_r, ruc)) ) {
|
||||
u2_lo_show("clu", clu);
|
||||
u2_ho_warn_here();
|
||||
c3_assert(0);
|
||||
u2_rz(bas_r, dac); u2_rz(bas_r, bat); return u2_none;
|
||||
}
|
||||
pet = u2_rc(bas_r, u2_rx(bas_r, axe), u2_rx(bas_r, led));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return u2_rt(bas_r, dac, bat, pet);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ds_wipe():
|
||||
**
|
||||
** Clear dashboard.
|
||||
*/
|
||||
void
|
||||
u2_ds_wipe(u2_wire wir_r)
|
||||
{
|
||||
u2_noun bas_r = u2_wire_bas_r(wir_r);
|
||||
|
||||
u2_cs_lose(bas_r, u2_wire_des_r(wir_r));
|
||||
}
|
||||
|
||||
/* u2_ds_mine():
|
||||
**
|
||||
** Register and/or save core.
|
||||
*/
|
||||
u2_noun // transfer
|
||||
u2_ds_mine(u2_wire wir_r,
|
||||
u2_noun clu, // retain
|
||||
u2_noun cor) // transfer
|
||||
{
|
||||
u2_noun bas_r = u2_wire_bas_r(wir_r);
|
||||
|
||||
if ( u2_no == u2_dust(cor) ) {
|
||||
return cor;
|
||||
} else {
|
||||
u2_noun pay = u2_t(cor);
|
||||
u2_noun bat = u2_h(cor);
|
||||
u2_noun pug = u2_cs_find(bas_r, u2_wire_des_r(wir_r), 0, bat);
|
||||
u2_noun xip, bat_xip;
|
||||
u2_noun gop;
|
||||
|
||||
if ( u2_none == pug ) {
|
||||
pug = u2_nul;
|
||||
}
|
||||
if ( u2_none == (xip = _ds_scan(pug, cor)) ) {
|
||||
gop = u2_rc(bas_r, (xip = _ds_chip(wir_r, clu, cor)), u2_rx(bas_r, pug));
|
||||
|
||||
if ( u2_none == gop ) {
|
||||
return cor;
|
||||
} else {
|
||||
bat_xip = u2_h(u2_t(xip));
|
||||
|
||||
#if 0
|
||||
{
|
||||
c3_c* xip_c = u2_ho_cstring(xip);
|
||||
|
||||
fprintf(stderr, "!%s - lent %d\r\n", xip_c, u2_ckb_lent(gop));
|
||||
free(xip_c);
|
||||
}
|
||||
#endif
|
||||
gop = u2_cs_save(bas_r, u2_wire_des_r(wir_r), 0, bat_xip, gop);
|
||||
{
|
||||
u2_noun poo = u2_cs_find(bas_r, u2_wire_des_r(wir_r), 0, bat_xip);
|
||||
|
||||
{
|
||||
_ds_scan(poo, cor);
|
||||
}
|
||||
}
|
||||
u2_rz(bas_r, gop);
|
||||
|
||||
}
|
||||
}
|
||||
else {
|
||||
bat_xip = u2_h(u2_t(xip));
|
||||
}
|
||||
|
||||
if ( bat_xip != bat ) {
|
||||
u2_noun cyr = u2_rc(wir_r, bat_xip, u2_rx(wir_r, pay));
|
||||
|
||||
if ( u2_none == cyr ) {
|
||||
return cor;
|
||||
}
|
||||
else {
|
||||
u2_rz(wir_r, cor);
|
||||
return cyr;
|
||||
}
|
||||
}
|
||||
else return cor;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ds_leap(): formula from name and chip.
|
||||
*/
|
||||
static u2_weak // senior
|
||||
_ds_leap(u2_wire wir_r,
|
||||
u2_noun xip, // retain
|
||||
const c3_c* tam_c) // retain
|
||||
{
|
||||
u2_noun dac = u2_h(xip);
|
||||
u2_noun pic = u2_t(dac);
|
||||
|
||||
while ( u2_nul != pic ) {
|
||||
u2_noun i_pic = u2_h(pic);
|
||||
u2_noun t_pic = u2_t(pic);
|
||||
|
||||
if ( u2_yes == u2_sing_c(tam_c, u2_h(i_pic)) ) {
|
||||
return u2_t(i_pic);
|
||||
}
|
||||
else pic = t_pic;
|
||||
}
|
||||
return u2_none;
|
||||
}
|
||||
|
||||
/* u2_ds_look():
|
||||
**
|
||||
** Produce hook formula from core, or u2_none.
|
||||
*/
|
||||
u2_weak // produce
|
||||
u2_ds_look(u2_wire wir_r,
|
||||
u2_noun cor, // retain
|
||||
const c3_c* tam_c) // retain
|
||||
{
|
||||
u2_noun xip = u2_ds_find(wir_r, cor);
|
||||
|
||||
if ( u2_none == xip ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
c3_l axe_l = _1;
|
||||
|
||||
while ( 1 ) {
|
||||
u2_noun fol = _ds_leap(wir_r, xip, tam_c);
|
||||
|
||||
if ( u2_none == fol ) {
|
||||
u2_noun pet = u2_t(u2_t(xip));
|
||||
|
||||
if ( _0 == pet ) {
|
||||
// printf("no joy - %s\n", tam_c);
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
u2_axis pax = u2_h(pet);
|
||||
|
||||
c3_assert(u2_fly_is_cat(pax));
|
||||
c3_assert((u2_ax_dep(axe_l) + u2_ax_dep(pax)) <= 30);
|
||||
|
||||
axe_l = u2_ax_peg(axe_l, pax);
|
||||
xip = u2_t(pet);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ( _1 != axe_l ) {
|
||||
return u2_rt(wir_r, u2_nock_flac,
|
||||
u2_rc(wir_r, u2_nock_frag, axe_l),
|
||||
fol);
|
||||
}
|
||||
else return fol;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ds_fire():
|
||||
**
|
||||
** Fire formula from core.
|
||||
*/
|
||||
u2_weak // produce
|
||||
u2_ds_fire(u2_wire wir_r,
|
||||
u2_noun cor, // retain
|
||||
const c3_c* tam_c) // retain
|
||||
{
|
||||
u2_noun fol = u2_ds_look(wir_r, cor, tam_c);
|
||||
|
||||
if ( u2_none == fol ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
u2_noun pro = u2_nk_nock(wir_r, u2_rx(wir_r, cor), fol);
|
||||
|
||||
u2_rz(wir_r, fol);
|
||||
return pro;
|
||||
}
|
||||
}
|
||||
26
f/hevn.c
26
f/hevn.c
@ -1,26 +0,0 @@
|
||||
/* f/hevn.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* u2_hv_init(): initialize state.
|
||||
*/
|
||||
u2_ray
|
||||
u2_hv_init(u2_ray wir_r)
|
||||
{
|
||||
u2_ray hev_r = u2_rl_ralloc(wir_r, c3_wiseof(u2_loom_hevn));
|
||||
|
||||
u2_hevx_be(hev_r, u2_pryr, god) = 0;
|
||||
u2_hevx_at(hev_r, lad) = 0;
|
||||
|
||||
return hev_r;
|
||||
}
|
||||
|
||||
/* u2_hv_mark(): mark heaven for gc.
|
||||
*/
|
||||
c3_w
|
||||
u2_hv_mark(void)
|
||||
{
|
||||
return u2_rl_gc_mark_noun(u2_Wire, u2_hevn_at(lad));
|
||||
}
|
||||
925
f/host.c
925
f/host.c
@ -1,925 +0,0 @@
|
||||
/* f/host.c: driver system.
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "f/nash.h"
|
||||
extern void u2_lo_show(c3_c*, u2_noun);
|
||||
|
||||
/** Global structures.
|
||||
**/
|
||||
/* Suppress warnings. Set after the first.
|
||||
*/
|
||||
c3_t JetSuppress;
|
||||
|
||||
/* Hangar stack; top hangar is active.
|
||||
*/
|
||||
u2_ho_hangar *u2_HostHangar;
|
||||
|
||||
|
||||
/** Forward declarations.
|
||||
**/
|
||||
/* _ho_explore(): find driver from chip, caching.
|
||||
*/
|
||||
static u2_ho_driver*
|
||||
_ho_explore(u2_ray, u2_noun);
|
||||
|
||||
/* _ho_mop_decimal(): measure/print decimal number.
|
||||
*/
|
||||
static c3_w
|
||||
_ho_mop_decimal(c3_c *buf_c, u2_noun num)
|
||||
{
|
||||
if ( u2_no == u2_stud(num) ) {
|
||||
return 0;
|
||||
} else {
|
||||
if ( 0 == num ) {
|
||||
if ( buf_c ) *buf_c = '0';
|
||||
return 1;
|
||||
} else {
|
||||
mpz_t num_mp;
|
||||
c3_w len_w;
|
||||
|
||||
u2_mp(num_mp, num);
|
||||
len_w = mpz_sizeinbase(num_mp, 10);
|
||||
|
||||
if ( buf_c ) {
|
||||
gmp_sprintf(buf_c, "%Zu", num_mp);
|
||||
}
|
||||
mpz_clear(num_mp);
|
||||
return len_w;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _ho_mop_term(): measure/print term.
|
||||
*/
|
||||
static c3_w
|
||||
_ho_mop_term(c3_c *buf_c, u2_noun tam)
|
||||
{
|
||||
if ( u2_no == u2_stud(tam) ) {
|
||||
return 0;
|
||||
}
|
||||
else {
|
||||
c3_w len_w = u2_met(3, tam);
|
||||
|
||||
if ( buf_c ) {
|
||||
u2_bytes(0, len_w, (c3_y *)buf_c, tam);
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
if ( !((buf_c[i_w] >= 'a') && (buf_c[i_w] <= 'z')) ) {
|
||||
buf_c[i_w] = '_';
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return len_w;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ho_mop_version(): measure/print version.
|
||||
*/
|
||||
static c3_w
|
||||
_ho_mop_version(c3_c *buf_c, u2_noun ver)
|
||||
{
|
||||
if ( u2_no == u2_dust(ver) ) {
|
||||
return _ho_mop_decimal(buf_c, ver);
|
||||
}
|
||||
else {
|
||||
c3_w len_w = _ho_mop_decimal(buf_c, u2_h(ver));
|
||||
|
||||
if ( buf_c ) buf_c += len_w;
|
||||
len_w++;
|
||||
if ( buf_c ) *buf_c++ = 'x';
|
||||
|
||||
return (len_w + _ho_mop_decimal(buf_c, u2_t(ver)));
|
||||
}
|
||||
}
|
||||
|
||||
/* _ho_mop_seal(): measure/print identity declaration.
|
||||
*/
|
||||
static c3_w
|
||||
_ho_mop_seal(c3_c *buf_c, u2_noun mek)
|
||||
{
|
||||
u2_noun std, ven, pro, ver, kel;
|
||||
c3_w len_w, lan_w, lon_w, lin_w;
|
||||
|
||||
if ( u2_yes == u2_as_qual(mek, &ven, &pro, &ver, &kel) ) {
|
||||
len_w = _ho_mop_term(buf_c, ven);
|
||||
if ( buf_c ) buf_c += len_w;
|
||||
len_w++;
|
||||
if ( buf_c ) *buf_c++ = '_';
|
||||
|
||||
lan_w = _ho_mop_term(buf_c, pro);
|
||||
if ( buf_c ) buf_c += lan_w;
|
||||
lan_w++;
|
||||
if ( buf_c ) *buf_c++ = '_';
|
||||
|
||||
lon_w = _ho_mop_version(buf_c, ver);
|
||||
if ( buf_c ) buf_c += lon_w;
|
||||
lon_w++;
|
||||
if ( buf_c ) *buf_c++ = '_';
|
||||
|
||||
lin_w = _ho_mop_decimal(buf_c, kel);
|
||||
if ( buf_c ) buf_c += lin_w;
|
||||
|
||||
return (len_w + lan_w + lon_w + lin_w);
|
||||
}
|
||||
else if ( u2_yes == u2_as_trel(mek, &ven, &pro, &kel) ) {
|
||||
len_w = _ho_mop_term(buf_c, ven);
|
||||
if ( buf_c ) buf_c += len_w;
|
||||
len_w++;
|
||||
if ( buf_c ) *buf_c++ = '_';
|
||||
|
||||
lan_w = _ho_mop_term(buf_c, pro);
|
||||
if ( buf_c ) buf_c += lan_w;
|
||||
lan_w++;
|
||||
if ( buf_c ) *buf_c++ = '_';
|
||||
|
||||
lon_w = _ho_mop_decimal(buf_c, kel);
|
||||
if ( buf_c ) buf_c += lon_w;
|
||||
lon_w++;
|
||||
if ( buf_c ) *buf_c++ = '_';
|
||||
|
||||
return (len_w + lan_w + lon_w);
|
||||
}
|
||||
else if ( u2_yes == u2_as_cell(mek, &std, &kel) ) {
|
||||
len_w = _ho_mop_term(buf_c, std);
|
||||
if ( buf_c ) buf_c += len_w;
|
||||
len_w++;
|
||||
if ( buf_c ) *buf_c++ = '_';
|
||||
|
||||
lan_w = _ho_mop_decimal(buf_c, kel);
|
||||
if ( buf_c ) buf_c += lan_w;
|
||||
|
||||
return (len_w + lan_w);
|
||||
}
|
||||
else {
|
||||
len_w = _ho_mop_term(buf_c, mek);
|
||||
|
||||
return len_w;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ho_mop_chip(): measure/print control string, from chip.
|
||||
*/
|
||||
static c3_w
|
||||
_ho_mop_chip(c3_c *buf_c, u2_noun xip)
|
||||
{
|
||||
u2_noun dac = u2_h(xip);
|
||||
u2_noun pit = u2_t(u2_t(xip));
|
||||
|
||||
if ( u2_nul == pit ) {
|
||||
return _ho_mop_seal(buf_c, u2_h(dac));
|
||||
}
|
||||
else {
|
||||
c3_w len_w = _ho_mop_chip(buf_c, u2_t(pit));
|
||||
|
||||
if ( buf_c ) {
|
||||
buf_c += len_w;
|
||||
*buf_c++ = '_';
|
||||
*buf_c++ = '_';
|
||||
}
|
||||
return (len_w + 2 + _ho_mop_seal(buf_c, u2_h(dac)));
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ho_cstring(): return malloced control string for `xip`.
|
||||
*/
|
||||
c3_c* // produce
|
||||
u2_ho_cstring(u2_noun xip) // retain
|
||||
{
|
||||
c3_w len_w = _ho_mop_chip(0, xip);
|
||||
c3_c *cos_c;
|
||||
|
||||
if ( !(cos_c = c3_malloc(len_w + 1)) ) abort();
|
||||
|
||||
_ho_mop_chip(cos_c, xip);
|
||||
cos_c[len_w] = 0;
|
||||
|
||||
return cos_c;
|
||||
}
|
||||
|
||||
/* u2_ho_boot():
|
||||
**
|
||||
** Boot driver system. Note that all chips and
|
||||
** tools are considered permanent between reboots.
|
||||
*/
|
||||
static void
|
||||
_ho_boot(u2_ho_hangar *hag)
|
||||
{
|
||||
hag->bad_s = u2_na_make();
|
||||
}
|
||||
|
||||
/* _ho_down():
|
||||
**
|
||||
** Release all resources in `hag`.
|
||||
*/
|
||||
static void
|
||||
_ho_down(u2_ho_hangar *hag)
|
||||
{
|
||||
u2_na_take(hag->bad_s);
|
||||
}
|
||||
|
||||
/* u2_ho_push():
|
||||
**
|
||||
** Push a driver hangar (corresponding to a jet shed).
|
||||
*/
|
||||
void
|
||||
u2_ho_push(void)
|
||||
{
|
||||
u2_ho_hangar *hag = c3_malloc(sizeof(u2_ho_hangar));
|
||||
|
||||
_ho_boot(hag);
|
||||
hag->nex_h = u2_HostHangar;
|
||||
u2_HostHangar = hag;
|
||||
}
|
||||
|
||||
/* u2_ho_popp():
|
||||
**
|
||||
** Pop a hangar.
|
||||
*/
|
||||
void
|
||||
u2_ho_popp(void)
|
||||
{
|
||||
u2_ho_hangar *hag = u2_HostHangar;
|
||||
u2_ho_hangar *nex_h = hag->nex_h;
|
||||
|
||||
_ho_down(hag);
|
||||
free(hag);
|
||||
u2_HostHangar = nex_h;
|
||||
}
|
||||
|
||||
/* u2_ho_klar():
|
||||
**
|
||||
** Clear and release all hangars.
|
||||
*/
|
||||
void
|
||||
u2_ho_klar(void)
|
||||
{
|
||||
while ( u2_HostHangar ) {
|
||||
u2_ho_popp();
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ho_warn(): report a warning, file and line.
|
||||
*/
|
||||
void
|
||||
u2_ho_warn(const c3_c* fil_c,
|
||||
c3_w lyn_w)
|
||||
{
|
||||
if ( !JetSuppress ) {
|
||||
fprintf(stderr, "ho: warn: %s:%u\n", fil_c, lyn_w);
|
||||
JetSuppress = 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* _ho_abstract(): compute 31-bit jet axis in core battery.
|
||||
*/
|
||||
static c3_l
|
||||
_ho_abstract(u2_noun xip, // retain
|
||||
const c3_c *fcs_c) // retain
|
||||
{
|
||||
if ( *fcs_c == '.' ) {
|
||||
c3_d axe_d = 0;
|
||||
c3_l axe_l = 0;
|
||||
|
||||
sscanf(fcs_c+1, "%llu", &axe_d);
|
||||
if ( axe_d >> 32ULL ||
|
||||
((1 << 31) & (axe_l = (c3_w)axe_d)) ||
|
||||
(axe_l < 2) )
|
||||
{
|
||||
u2_ho_warn_here();
|
||||
return 0;
|
||||
}
|
||||
// return u2_ax_mas(axe_l);
|
||||
return axe_l;
|
||||
}
|
||||
else {
|
||||
u2_noun nut = u2_t(u2_h(xip));
|
||||
|
||||
while ( _0 != nut ) {
|
||||
u2_noun i_nut = u2_h(nut);
|
||||
|
||||
if ( (u2_yes == u2_sing_c(fcs_c, u2_h(i_nut))) ) {
|
||||
u2_noun fal = u2_t(i_nut);
|
||||
|
||||
while ( (u2_yes == u2_dust(fal)) && (u2_nock_hint == u2_h(fal)) ) {
|
||||
fal = u2_t(u2_t(fal));
|
||||
}
|
||||
/* `fal` must match `[9 x [0 1]]`
|
||||
*/
|
||||
if ( (u2_yes == u2_dust(fal)) && (u2_nock_kick == u2_h(fal)) ) {
|
||||
u2_noun t_fal = u2_t(fal);
|
||||
|
||||
if ( u2_yes == u2_dust(t_fal) ) {
|
||||
u2_noun ht_fal = u2_h(t_fal);
|
||||
u2_noun tt_fal = u2_t(t_fal);
|
||||
|
||||
if ( (u2_yes == u2_stud(ht_fal)) &&
|
||||
(u2_yes == u2_dust(tt_fal)) &&
|
||||
(_0 == u2_h(tt_fal)) &&
|
||||
(_1 == u2_t(tt_fal)) )
|
||||
{
|
||||
u2_atom axe = ht_fal;
|
||||
|
||||
if ( !u2_fly_is_cat(axe) ) {
|
||||
u2_ho_warn_here();
|
||||
}
|
||||
// return u2_ax_mas(axe);
|
||||
return axe;
|
||||
}
|
||||
}
|
||||
}
|
||||
printf("weird! cos_c %s\n", u2_ho_cstring(xip));
|
||||
u2_ho_warn_here();
|
||||
return 0;
|
||||
}
|
||||
nut = u2_t(nut);
|
||||
}
|
||||
printf("wacky! cos_c %s, fcs_c %s\n", u2_ho_cstring(xip), fcs_c);
|
||||
u2_ho_warn_here();
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ho_attach(): process static driver for execution.
|
||||
*/
|
||||
static void
|
||||
_ho_attach(u2_rail ral_r,
|
||||
u2_ho_driver* dry_d) // retain
|
||||
{
|
||||
u2_ho_jet* jet_j;
|
||||
c3_w i_w;
|
||||
|
||||
dry_d->jax_s = u2_na_make();
|
||||
|
||||
if ( dry_d->fan_j ) {
|
||||
for ( i_w = 0; (jet_j = &dry_d->fan_j[i_w])->fcs_c; i_w++ ) {
|
||||
jet_j->xip = dry_d->xip;
|
||||
jet_j->axe_l = _ho_abstract(dry_d->xip, jet_j->fcs_c);
|
||||
|
||||
u2_na_put(dry_d->jax_s, jet_j->axe_l, jet_j);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _ho_explore_dummy(): produce dummy driver.
|
||||
*/
|
||||
static u2_ho_driver* // produce
|
||||
_ho_explore_dummy(u2_rail ral_r,
|
||||
const c3_c* cos_c, // submit
|
||||
u2_noun xip) // senior
|
||||
{
|
||||
u2_ho_driver *dry_d;
|
||||
|
||||
dry_d = c3_malloc(sizeof(*dry_d));
|
||||
dry_d->cos_c = cos_c;
|
||||
dry_d->sub_d = 0;
|
||||
dry_d->xip = xip;
|
||||
dry_d->jax_s = u2_na_make();
|
||||
dry_d->fan_j = c3_malloc(sizeof(*dry_d->fan_j));
|
||||
dry_d->fan_j->fcs_c = 0;
|
||||
|
||||
return dry_d;
|
||||
}
|
||||
|
||||
/* _ho_explore_static(): find driver from built-in list, or return 0.
|
||||
*/
|
||||
static u2_ho_driver*
|
||||
_ho_explore_static(u2_rail ral_r,
|
||||
u2_noun xip,
|
||||
c3_c* cos_c)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w=0; HostDriverBase[i_w]; i_w++ ) {
|
||||
u2_ho_driver *dry_d = HostDriverBase[i_w];
|
||||
|
||||
if ( (u2_none == dry_d->xip) && !strcmp(cos_c, dry_d->cos_c) ) {
|
||||
dry_d->xip = xip;
|
||||
free(cos_c);
|
||||
|
||||
u2_na_put(u2_HostHangar->bad_s, xip, dry_d);
|
||||
return dry_d;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* _ho_explore_parent(): find driver from parent, or return 0.
|
||||
*/
|
||||
static u2_ho_driver*
|
||||
_ho_explore_parent(u2_rail ral_r,
|
||||
u2_noun xip,
|
||||
c3_c* cos_c)
|
||||
{
|
||||
u2_noun pet = u2_t(u2_t(xip));
|
||||
|
||||
if ( _0 == pet ) {
|
||||
return 0;
|
||||
} else {
|
||||
u2_ho_driver* par_d = _ho_explore(ral_r, u2_t(pet));
|
||||
c3_w i_w;
|
||||
|
||||
c3_assert(par_d);
|
||||
if ( par_d->sub_d ) {
|
||||
for ( i_w = 0; par_d->sub_d[i_w].cos_c; i_w++ ) {
|
||||
#if 0
|
||||
if ( (u2_none == par_d->sub_d[i_w].xip) &&
|
||||
!strcmp(cos_c, par_d->sub_d[i_w].cos_c) )
|
||||
#else
|
||||
if ( !strcmp(cos_c, par_d->sub_d[i_w].cos_c) )
|
||||
#endif
|
||||
{
|
||||
u2_ho_driver *dry_d = &par_d->sub_d[i_w];
|
||||
|
||||
if ( u2_none != dry_d->xip ) {
|
||||
u2z(dry_d->xip);
|
||||
}
|
||||
dry_d->xip = xip;
|
||||
free(cos_c);
|
||||
|
||||
u2_na_put(u2_HostHangar->bad_s, xip, dry_d);
|
||||
return dry_d;
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ho_explore(): find driver from chip, caching.
|
||||
*/
|
||||
static u2_ho_driver* // discover
|
||||
_ho_explore(u2_rail ral_r,
|
||||
u2_noun xip) // senior
|
||||
{
|
||||
u2_ho_driver* dry_d;
|
||||
c3_b ign;
|
||||
|
||||
if ( 0 != (dry_d = u2_na_get_ptr(u2_HostHangar->bad_s, xip, &ign)) ) {
|
||||
return dry_d;
|
||||
} else {
|
||||
c3_c* cos_c = u2_ho_cstring(xip);
|
||||
|
||||
// fprintf(stderr, "ho_explore: cos_c %s\r\n", cos_c);
|
||||
if ( 0 != (dry_d = _ho_explore_parent(ral_r, xip, cos_c)) ) {
|
||||
// fprintf(stderr, "battery: child : %s\r\n", cos_c);
|
||||
_ho_attach(ral_r, dry_d);
|
||||
return dry_d;
|
||||
}
|
||||
else if ( 0 != (dry_d = _ho_explore_static(ral_r, xip, cos_c)) ) {
|
||||
// fprintf(stderr, "battery: static: %s\r\n", cos_c);
|
||||
_ho_attach(ral_r, dry_d);
|
||||
return dry_d;
|
||||
}
|
||||
else {
|
||||
// fprintf(stderr, "battery: dummy : %s\n", cos_c);
|
||||
dry_d = _ho_explore_dummy(ral_r, cos_c, xip);
|
||||
|
||||
u2_na_put(u2_HostHangar->bad_s, xip, dry_d);
|
||||
return dry_d;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ho_prepare(): prepare jets in `xip`.
|
||||
*/
|
||||
void
|
||||
u2_ho_prepare(u2_rail ral_r,
|
||||
u2_noun xip) // retain
|
||||
{
|
||||
_ho_explore(ral_r, xip);
|
||||
}
|
||||
|
||||
/* _ho_conquer(): find jet from xip and axe.
|
||||
*/
|
||||
static u2_ho_jet*
|
||||
_ho_conquer(u2_rail ral_r,
|
||||
u2_noun xip,
|
||||
u2_atom axe)
|
||||
{
|
||||
u2_ho_driver *dry_d;
|
||||
|
||||
if ( 0 == (dry_d = _ho_explore(ral_r, xip)) ) {
|
||||
return 0;
|
||||
} else if ( 0 == dry_d->fan_j ) {
|
||||
return 0;
|
||||
} else {
|
||||
if ( 3 == axe ) {
|
||||
// Linear search - slow, except in this common case.
|
||||
//
|
||||
u2_ho_jet *jet_j = dry_d->fan_j;
|
||||
|
||||
while ( jet_j->fcs_c ) {
|
||||
if ( axe == jet_j->axe_l ) {
|
||||
return jet_j;
|
||||
}
|
||||
jet_j++;
|
||||
}
|
||||
return 0;
|
||||
} else {
|
||||
c3_b ign;
|
||||
return u2_na_get_ptr(dry_d->jax_s, axe, &ign);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef NOCK6
|
||||
#define _ho_con u2_cw_con
|
||||
#define _ho_sam u2_cw_sam
|
||||
#else
|
||||
#define _ho_con u2_cv_con
|
||||
#define _ho_sam u2_cv_sam
|
||||
#endif
|
||||
|
||||
/* u2_ho_test():
|
||||
**
|
||||
** Report result of jet test. `had` is native; `sof` is nock.
|
||||
*/
|
||||
void
|
||||
u2_ho_test(u2_wire wir_r,
|
||||
u2_ho_jet* jet_j,
|
||||
u2_noun cor, // retain
|
||||
u2_noun sof, // retain
|
||||
u2_noun had) // retain
|
||||
{
|
||||
if ( (u2_none == cor) ||
|
||||
((u2_none == had) && (u2_none == sof)) ||
|
||||
(u2_none == jet_j->xip) )
|
||||
{
|
||||
return;
|
||||
} else {
|
||||
c3_c* cos_c = u2_ho_cstring(jet_j->xip);
|
||||
c3_w mug_w = u2_mug(cor);
|
||||
const c3_c* msg_c;
|
||||
|
||||
if ( u2_none == had ) {
|
||||
msg_c = "bail";
|
||||
printf("bail: cos_c: %s\r\n", cos_c);
|
||||
c3_assert(0);
|
||||
} else if ( u2_none == sof ) {
|
||||
msg_c = "funk";
|
||||
printf("funk: cos_c: %s\r\n", cos_c);
|
||||
c3_assert(0);
|
||||
|
||||
} else if ( u2_no == u2_sing(had, sof) ) {
|
||||
msg_c = "miss";
|
||||
printf("miss: jet: %s(%s)\r\n", cos_c, jet_j->fcs_c);
|
||||
|
||||
u2_lo_show("right", u2k(sof));
|
||||
u2_lo_show("wrong", u2k(had));
|
||||
|
||||
// For detailed debugging, activate/extend this junkheap as needed.
|
||||
//
|
||||
c3_assert(0);
|
||||
#if 0
|
||||
|
||||
{
|
||||
u2_noun gen;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, _ho_sam, &gen, 0)) ) {
|
||||
c3_assert(0);
|
||||
} else {
|
||||
u2_err(wir_r, "gen", gen);
|
||||
}
|
||||
}
|
||||
|
||||
{
|
||||
u2_noun sut, gen, van;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, _ho_con, &van, _ho_sam, &gen, 0)) ||
|
||||
(u2_none == (sut = u2_frag(_ho_sam, van))) )
|
||||
{
|
||||
c3_assert(0);
|
||||
} else {
|
||||
u2_err(wir_r, "h_sut", u2_h(sut));
|
||||
u2_err(wir_r, "gen", gen);
|
||||
}
|
||||
}
|
||||
{
|
||||
u2_noun sut, ref, van;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, _ho_con, &van, _ho_sam, &ref, 0)) ||
|
||||
(u2_none == (sut = u2_frag(_ho_sam, van))) )
|
||||
{
|
||||
c3_assert(0);
|
||||
} else {
|
||||
u2_err(wir_r, "sut", sut);
|
||||
u2_err(wir_r, "ref", ref);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
// LoomStop = 1;
|
||||
c3_assert(0);
|
||||
} else {
|
||||
msg_c = "nice";
|
||||
}
|
||||
|
||||
if ( strcmp("nice", msg_c) )
|
||||
{
|
||||
fprintf(stderr, "%s: %8x: %s\n", msg_c, mug_w, cos_c);
|
||||
}
|
||||
free(cos_c);
|
||||
}
|
||||
}
|
||||
|
||||
/* _ho_run(): execute jet, new simplified style.
|
||||
*/
|
||||
static u2_weak // produce
|
||||
_ho_run(u2_ray wir_r,
|
||||
u2_ho_jet* jet_j,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun ret;
|
||||
|
||||
u2_tx_glu_bit(wir_r, u2_no);
|
||||
ret = jet_j->fun_f(wir_r, cor);
|
||||
u2_tx_glu_bit(wir_r, u2_yes);
|
||||
|
||||
if ( u2_none == ret ) {
|
||||
return u2_cm_bail(c3__exit);
|
||||
}
|
||||
else return ret;
|
||||
}
|
||||
|
||||
#if 0
|
||||
/* _ho_run(): execute jet, shedding trace if any is available.
|
||||
*/
|
||||
static u2_weak // produce
|
||||
_ho_run(u2_ray wir_r,
|
||||
u2_ho_jet* jet_j,
|
||||
u2_noun cor, // retain
|
||||
u2_weak *tax) // produce
|
||||
{
|
||||
u2_noun ret;
|
||||
|
||||
switch ( jet_j->vok_m ) {
|
||||
default: c3_assert(0); return u2_none;
|
||||
|
||||
case c3__lite: {
|
||||
/* Lite jet: bail prohibited. The lite jet must detect and control
|
||||
** its own internal errors, freeing stray nouns and returning u2_none
|
||||
** if and only if nock exits.
|
||||
**
|
||||
** u2_b functions may not be used. Trace must be correct.
|
||||
**
|
||||
** Pro: lite jets minimize invocation latency.
|
||||
** Pro: no garbage collection is required on error.
|
||||
**
|
||||
** Con: manual programming of large functions in lite mode is difficult.
|
||||
*/
|
||||
{
|
||||
u2_noun hoc = u2_rx(wir_r, u2_wire_tax(wir_r));
|
||||
u2_ray kit_r = u2_wire_kit_r(wir_r);
|
||||
u2_noun ret;
|
||||
|
||||
u2_wire_kit_r(wir_r) = 0;
|
||||
u2_tx_glu_bit(wir_r, u2_no);
|
||||
ret = jet_j->fun_f(wir_r, cor);
|
||||
u2_tx_glu_bit(wir_r, u2_yes);
|
||||
u2_wire_kit_r(wir_r) = kit_r;
|
||||
|
||||
if ( u2_none == ret ) {
|
||||
// Restore base trace; shed C-generated trace.
|
||||
//
|
||||
*tax = u2_rx(wir_r, u2_wire_tax(wir_r));
|
||||
u2_wire_tax(wir_r) = hoc;
|
||||
} else {
|
||||
// Jet should return base trace.
|
||||
//
|
||||
c3_assert(hoc == u2_wire_tax(wir_r));
|
||||
u2_rz(wir_r, hoc);
|
||||
*tax = u2_none;
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
}
|
||||
case c3__hevy: {
|
||||
/* Hevy jet: maintains recursive bail context. The hevy jet can
|
||||
** bail out at any time. The host framework should (but does not
|
||||
** yet) free stray nouns.
|
||||
**
|
||||
** Pro: hevy jets are the easiest to program.
|
||||
**
|
||||
** Con: invocation latency is higher.
|
||||
*/
|
||||
{
|
||||
u2_ray kit_r = u2_bl_open(wir_r);
|
||||
c3_l how_l;
|
||||
|
||||
if ( 0 == u2_wire_kit_r(u2_Wire) ) {
|
||||
c3_assert(0);
|
||||
}
|
||||
if ( (how_l = u2_bl_set(wir_r)) ) {
|
||||
if ( (c3__exit == how_l) || (c3__intr == how_l) ) {
|
||||
// The jet promises that its trace calculations are correct.
|
||||
//
|
||||
*tax = u2_rx(wir_r, u2_wire_tax(wir_r));
|
||||
u2_wire_tax(wir_r) = u2_rx
|
||||
(wir_r, u2_kite_tax(u2_wire_kit_r(wir_r)));
|
||||
}
|
||||
else {
|
||||
// Something failed - nothing is promised.
|
||||
//
|
||||
*tax = u2_none;
|
||||
}
|
||||
u2_bl_done(wir_r, kit_r);
|
||||
ret = u2_none;
|
||||
}
|
||||
else {
|
||||
u2_tx_glu_bit(wir_r, u2_no);
|
||||
ret = jet_j->fun_f(wir_r, cor);
|
||||
u2_tx_glu_bit(wir_r, u2_yes);
|
||||
*tax = u2_none;
|
||||
|
||||
c3_assert(u2_wire_tax(wir_r) == u2_kite_tax(u2_wire_kit_r(wir_r)));
|
||||
u2_bl_done(wir_r, kit_r);
|
||||
}
|
||||
if ( 0 == u2_wire_kit_r(u2_Wire) ) {
|
||||
c3_assert(0);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* u2_ho_use():
|
||||
**
|
||||
** Run a jet. Equivalence testing now disabled.
|
||||
*/
|
||||
u2_weak // produce
|
||||
u2_ho_use(u2_ray wir_r,
|
||||
u2_ho_jet* jet_j,
|
||||
u2_noun cor, // retain
|
||||
u2_noun fol) // retain
|
||||
{
|
||||
u2_noun pro, key;
|
||||
|
||||
if ( !(jet_j->sat_s & u2_jet_live) ) {
|
||||
if ( (jet_j->sat_s & u2_jet_memo) &&
|
||||
(u2_none != (key = (jet_j->key_f(wir_r, cor)))) )
|
||||
{
|
||||
u2_noun fun_m = jet_j->fun_m;
|
||||
u2_noun val;
|
||||
|
||||
if ( u2_none != (val = u2_rl_find(wir_r, fun_m, key)) ) {
|
||||
pro = val;
|
||||
}
|
||||
else {
|
||||
pro = u2_cn_nock(u2_rx(wir_r, cor), u2_rx(wir_r, fol));
|
||||
|
||||
pro = u2_rl_save(wir_r, fun_m, key, pro);
|
||||
}
|
||||
u2_rz(wir_r, key);
|
||||
}
|
||||
else {
|
||||
// printf("use %s\n", u2_ho_cstring(jet_j->xip));
|
||||
pro = u2_cn_nock(u2_rx(wir_r, cor), u2_rx(wir_r, fol));
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ( !(jet_j->sat_s & u2_jet_test) ) {
|
||||
pro = _ho_run(wir_r, jet_j, cor);
|
||||
}
|
||||
else {
|
||||
// c3_assert(!"equivalence testing is currently disabled");
|
||||
#if 1
|
||||
u2_noun sof;
|
||||
|
||||
jet_j->sat_s &= ~u2_jet_test;
|
||||
{
|
||||
if ( !(jet_j->sat_s & u2_jet_leak) ) {
|
||||
pro = _ho_run(wir_r, jet_j, cor);
|
||||
} else {
|
||||
u2_ho_state mem = jet_j->sat_s;
|
||||
|
||||
jet_j->sat_s &= ~u2_jet_leak;
|
||||
jet_j->sat_s &= ~u2_jet_memo;
|
||||
{
|
||||
c3_w liv_w = u2_soup_liv_w(u2_rail_rut_r(wir_r));
|
||||
c3_w nex_w;
|
||||
|
||||
pro = _ho_run(wir_r, jet_j, cor);
|
||||
u2_rz(wir_r, pro);
|
||||
nex_w = u2_soup_liv_w(u2_rail_rut_r(wir_r));
|
||||
|
||||
if ( nex_w > liv_w ) {
|
||||
fprintf(stderr, "leak: %d, %s\n",
|
||||
(nex_w - liv_w), u2_ho_cstring(jet_j->xip));
|
||||
|
||||
c3_assert(0);
|
||||
}
|
||||
pro = _ho_run(wir_r, jet_j, cor);
|
||||
}
|
||||
jet_j->sat_s = mem;
|
||||
}
|
||||
}
|
||||
jet_j->sat_s |= u2_jet_test;
|
||||
|
||||
jet_j->sat_s &= ~u2_jet_live;
|
||||
{
|
||||
sof = u2_nk_soft(wir_r, u2_rx(wir_r, cor), fol);
|
||||
}
|
||||
jet_j->sat_s |= u2_jet_live;
|
||||
|
||||
// fprintf(stderr, "test %s\n", u2_ho_cstring(jet_j->xip));
|
||||
|
||||
u2_ho_test(wir_r, jet_j, cor, sof, pro);
|
||||
u2_tx_did_tes(wir_r, 1);
|
||||
|
||||
u2_rz(wir_r, pro);
|
||||
pro = sof;
|
||||
#endif
|
||||
}
|
||||
}
|
||||
return pro;
|
||||
}
|
||||
|
||||
/* u2_ho_kick():
|
||||
**
|
||||
** Apply host nock driver on `xip`, `cor`, `fol`.
|
||||
*/
|
||||
u2_weak // produce
|
||||
u2_ho_kick(u2_ray wir_r,
|
||||
u2_noun xip, // retain
|
||||
u2_noun cor, // retain
|
||||
u2_atom axe) // retain
|
||||
{
|
||||
u2_noun fol;
|
||||
u2_ho_jet* jet_j;
|
||||
|
||||
if ( u2_none == (fol = u2_frag(axe, cor)) ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
jet_j = _ho_conquer(wir_r, xip, axe);
|
||||
|
||||
if ( 0 == jet_j ) {
|
||||
#if 0
|
||||
c3_c* str_c = u2_ho_cstring(xip);
|
||||
printf("no jet: %s\r\n", str_c);
|
||||
free(str_c);
|
||||
#endif
|
||||
return u2_nk_soft(wir_r, u2_rx(wir_r, cor), fol);
|
||||
}
|
||||
else {
|
||||
u2_tx_did_jet(wir_r, 1);
|
||||
return u2_ho_use(wir_r, jet_j, cor, fol);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ho_kicq(): as u2_ho_kick(), but mocky.
|
||||
*/
|
||||
u2_noun // produce
|
||||
u2_ho_kicq(u2_ray wir_r,
|
||||
u2_noun xip, // retain
|
||||
u2_noun cor, // retain
|
||||
u2_atom axe, // retain
|
||||
u2_bean *pon) // retain
|
||||
{
|
||||
u2_noun hoe;
|
||||
|
||||
if ( 0 != (hoe = u2_cm_trap()) ) {
|
||||
u2_noun pro;
|
||||
|
||||
if ( u2h(hoe) == c3__exit ) {
|
||||
pro = u2k(u2t(hoe));
|
||||
|
||||
*pon = 2;
|
||||
u2z(hoe);
|
||||
return pro;
|
||||
}
|
||||
else if ( u2h(hoe) == c3__need ) {
|
||||
pro = u2k(u2t(hoe));
|
||||
|
||||
*pon = 1;
|
||||
u2z(hoe);
|
||||
return pro;
|
||||
}
|
||||
else if ( u2h(hoe) == c3__fail ) {
|
||||
fprintf(stderr, "\r\nfail from %s\n", u2_ho_cstring(xip));
|
||||
// u2_err(u2_Wire, "hhoe", u2h(hoe));
|
||||
// c3_assert(0);
|
||||
return u2_cm_bail(c3__fail);
|
||||
}
|
||||
else {
|
||||
fprintf(stderr, "\r\nbizarre exit from %s\n", u2_ho_cstring(xip));
|
||||
// u2_err(u2_Wire, "hhoe", u2h(hoe));
|
||||
c3_assert(0);
|
||||
return u2_cm_bowl(hoe);
|
||||
}
|
||||
}
|
||||
else {
|
||||
u2_noun pro = u2_ho_kick(wir_r, xip, cor, axe);
|
||||
|
||||
u2_cm_done();
|
||||
return pro;
|
||||
}
|
||||
}
|
||||
194
f/nash.c
194
f/nash.c
@ -1,194 +0,0 @@
|
||||
/* f/nash.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "f/nash.h"
|
||||
#include <bitmapped_patricia_tree.h>
|
||||
|
||||
/* structures
|
||||
*/
|
||||
/* u2_nair: bucket node.
|
||||
*/
|
||||
struct u2_nair {
|
||||
u2_noun key;
|
||||
void* val;
|
||||
};
|
||||
|
||||
/* u2_buck: realloced bucket.
|
||||
*/
|
||||
struct u2_buck {
|
||||
c3_w con_w;
|
||||
struct u2_nair* sto_u;
|
||||
};
|
||||
|
||||
/* u2_nash: wrapper around Patricia trie.
|
||||
*/
|
||||
struct u2_nash {
|
||||
bpt_t sto;
|
||||
};
|
||||
|
||||
void u2_na_dump(struct u2_nash* nas_u);
|
||||
|
||||
/* u2_na_make(): create a new nounhash-table.
|
||||
**
|
||||
** nashtables live in C memory and do not take refs.
|
||||
*/
|
||||
struct u2_nash*
|
||||
u2_na_make()
|
||||
{
|
||||
struct u2_nash* nas_u = calloc(1, sizeof(*nas_u));
|
||||
c3_assert(nas_u);
|
||||
// fprintf(stderr, "[%%nash-make %p]\r\n", nas_u);
|
||||
return nas_u;
|
||||
}
|
||||
|
||||
/* u2_na_put(): put into nash, replacing.
|
||||
*/
|
||||
void
|
||||
u2_na_put(struct u2_nash* nas_u, u2_noun key, void* val)
|
||||
{
|
||||
struct u2_buck* buc_u = 0;
|
||||
struct u2_nair* nuu_u = 0;
|
||||
c3_w sot_w = 0;
|
||||
c3_w i = 0;
|
||||
|
||||
u2_noun tom = u2_mug(key);
|
||||
|
||||
if ( !bpt_has_key(nas_u->sto, tom)) {
|
||||
bpt_t ots;
|
||||
|
||||
buc_u = calloc(1, sizeof(*buc_u));
|
||||
c3_assert(buc_u);
|
||||
ots = bpt_assoc(nas_u->sto, tom, buc_u);
|
||||
bpt_release(nas_u->sto);
|
||||
nas_u->sto = ots;
|
||||
#if 0
|
||||
fprintf(stderr, "[%%nash-sto %p %p]\r\n", nas_u->sto, tom);
|
||||
if (!bpt_has_key(nas_u->sto, tom)) {
|
||||
u2_na_dump(nas_u);
|
||||
assert(0);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
buc_u = bpt_get(nas_u->sto, tom);
|
||||
|
||||
if ( 0 == buc_u->con_w ) {
|
||||
c3_assert(buc_u->sto_u == 0);
|
||||
}
|
||||
else {
|
||||
for(i = 0; i < buc_u->con_w; i++) {
|
||||
if (u2_sing(buc_u->sto_u[i].key, key) == u2_yes) {
|
||||
buc_u->sto_u[i].val = val;
|
||||
#if 0
|
||||
fprintf(stderr, "[%%nash-rep %p %p %d]\r\n",
|
||||
(void*)key, (void*)val, i);
|
||||
#endif
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sot_w = buc_u->con_w;
|
||||
buc_u->con_w++;
|
||||
|
||||
nuu_u = realloc(buc_u->sto_u, buc_u->con_w * sizeof(struct u2_nair));
|
||||
c3_assert(nuu_u);
|
||||
|
||||
nuu_u[sot_w].key = key;
|
||||
nuu_u[sot_w].val = val;
|
||||
buc_u->sto_u = nuu_u;
|
||||
#if 0
|
||||
fprintf(stderr, "[%%nash-put %p %p %d]\r\n",
|
||||
(void*)key, (void*)val, sot_w);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* u2_na_get(): get a noun from a nounhash table.
|
||||
*/
|
||||
u2_weak
|
||||
u2_na_get(struct u2_nash* nas_u, u2_noun key)
|
||||
{
|
||||
u2_weak may;
|
||||
c3_b fon;
|
||||
may = (u2_noun)u2_na_get_ptr(nas_u, key, &fon);
|
||||
if (fon == u2_no) {
|
||||
return u2_none;
|
||||
}
|
||||
return (u2_noun)may;
|
||||
}
|
||||
|
||||
/* u2_na_get_ptr(): get a pointer from a nounhash table, along with a
|
||||
** bean indicating found status.
|
||||
*/
|
||||
void*
|
||||
u2_na_get_ptr(struct u2_nash* nas_u, u2_noun key, c3_b* found)
|
||||
{
|
||||
struct u2_buck* buc_u = 0;
|
||||
c3_w i;
|
||||
u2_noun tom = u2_mug(key);
|
||||
*found = u2_no;
|
||||
|
||||
if ( !bpt_has_key(nas_u->sto, tom) ) {
|
||||
// fprintf(stderr, "[%%nash-get-none %p %p]\r\n", nas_u->sto, tom);
|
||||
return 0;
|
||||
}
|
||||
|
||||
buc_u = bpt_get(nas_u->sto, tom);
|
||||
for(i = 0; i < buc_u->con_w; i++) {
|
||||
if (u2_sing(buc_u->sto_u[i].key, key) == u2_yes) {
|
||||
#if 0
|
||||
fprintf(stderr, "[%%nash-get %p %p %d]\r\n",
|
||||
(void*)key, (void*)buc_u->sto_u[i].val, i);
|
||||
#endif
|
||||
*found = u2_yes;
|
||||
return buc_u->sto_u[i].val;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* _na_drop(): deallocate a node.
|
||||
*/
|
||||
static void
|
||||
_na_drop(bpt_key_t x, void* a, void* b)
|
||||
{
|
||||
struct u2_buck* buc = a;
|
||||
free(buc->sto_u);
|
||||
free(buc);
|
||||
}
|
||||
|
||||
/* _na_dump(): debugging dump.
|
||||
*/
|
||||
void
|
||||
_na_dump(bpt_key_t x, void* a, void* b)
|
||||
{
|
||||
struct u2_buck* buc = a;
|
||||
int i;
|
||||
fprintf(stderr, "[%%nash-dump %x ", x);
|
||||
for(i=0;i<buc->con_w;i++) {
|
||||
fprintf(stderr, "%x->%p%s", buc->sto_u[i].key, buc->sto_u[i].val,
|
||||
i+1==buc->con_w?"":" ");
|
||||
}
|
||||
fprintf(stderr, "]\r\n");
|
||||
}
|
||||
|
||||
/* u2_na_dump(): debugging dump.
|
||||
*/
|
||||
void u2_na_dump(struct u2_nash* nas_u)
|
||||
{
|
||||
if(nas_u->sto) bpt_for_mappings(nas_u->sto, _na_dump, 0);
|
||||
}
|
||||
|
||||
/* u2_na_take(): destroy a nounhash table.
|
||||
*/
|
||||
void
|
||||
u2_na_take(struct u2_nash* nas_u)
|
||||
{
|
||||
if (nas_u->sto) bpt_for_mappings(nas_u->sto, _na_drop, 0);
|
||||
bpt_release(nas_u->sto);
|
||||
free(nas_u);
|
||||
|
||||
// fprintf(stderr, "[%%nash-take %p]\r\n", nash);
|
||||
}
|
||||
398
f/shed.c
398
f/shed.c
@ -1,398 +0,0 @@
|
||||
/* f/shed.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* _sh_good_sil()::
|
||||
*/
|
||||
static u2_flag
|
||||
_sh_good_sil(u2_noun sil)
|
||||
{
|
||||
// XX: verify seal.
|
||||
//
|
||||
return u2_yes;
|
||||
}
|
||||
|
||||
/* _sh_good_bud()::
|
||||
*/
|
||||
static u2_flag
|
||||
_sh_good_bud(u2_noun bud)
|
||||
{
|
||||
u2_noun p_bud, q_bud;
|
||||
|
||||
if ( _0 == bud ) {
|
||||
return u2_yes;
|
||||
}
|
||||
else if ( (u2_no == u2_as_cell(bud, &p_bud, &q_bud)) ) {
|
||||
return u2_no;
|
||||
}
|
||||
if ( (u2_nock_bone == p_bud) && (_0 == q_bud) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
if ( (u2_nock_frag == p_bud) && (u2_yes == u2_stud(q_bud)) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
else return u2_no;
|
||||
}
|
||||
|
||||
/* _sh_good_nut()::
|
||||
*/
|
||||
static u2_flag
|
||||
_sh_good_nut(u2_noun nut)
|
||||
{
|
||||
if ( u2_nul == nut ) {
|
||||
return u2_yes;
|
||||
} else {
|
||||
u2_noun i_nut, t_nut;
|
||||
u2_noun pi_nut, qi_nut;
|
||||
|
||||
if ( (u2_no == u2_as_cell(nut, &i_nut, &t_nut)) ||
|
||||
(u2_no == u2_as_cell(i_nut, &pi_nut, &qi_nut)) ||
|
||||
(u2_no == u2_stud(pi_nut)) )
|
||||
{
|
||||
return u2_no;
|
||||
}
|
||||
else return u2_yes;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_sh_mine(): substitute active, annotated battery.
|
||||
*/
|
||||
u2_weak // transfer
|
||||
u2_sh_mine(u2_ray wir_r,
|
||||
u2_clue clu, // retain
|
||||
u2_noun cor) // transfer
|
||||
{
|
||||
u2_ray bas_r;
|
||||
u2_noun pay, bat;
|
||||
u2_noun sil, bud, nut;
|
||||
u2_chip xip;
|
||||
|
||||
if ( 0 == (bas_r = u2_wire_bas_r(wir_r)) ) {
|
||||
return cor;
|
||||
}
|
||||
else if ( (u2_none == u2_as_cell(cor, &pay, &bat)) ||
|
||||
(u2_no == u2_dust(bat)) )
|
||||
{
|
||||
return cor;
|
||||
}
|
||||
else if ( u2_none != (xip = u2_ch_find(u2_bask_hag_r(bas_r), bat)) ) {
|
||||
u2_noun cyr;
|
||||
|
||||
if ( u2_none == (cyr = u2_rc(wir_r, u2_rx(wir_r, pay), u2_h(u2_t(xip)))) ) {
|
||||
return cor;
|
||||
}
|
||||
else {
|
||||
u2_rl_lose(wir_r, cor);
|
||||
|
||||
return cyr;
|
||||
}
|
||||
}
|
||||
else if ( (u2_no == u2_as_trel(clu, &bud, &sil, &nut)) ||
|
||||
(u2_no == _sh_good_bud(bud)) ||
|
||||
(u2_no == _sh_good_sil(sil)) ||
|
||||
(u2_no == _sh_good_nut(nut)) )
|
||||
{
|
||||
return cor;
|
||||
}
|
||||
else {
|
||||
u2_noun dac, bot, pet, xop, cyr;
|
||||
|
||||
dac = bot = pet = xop = cyr = u2_none;
|
||||
while ( 1 ) {
|
||||
/* disc: dac
|
||||
*/
|
||||
{
|
||||
if ( u2_none == (dac = u2_rl_take(bas_r, u2_t(clu))) ) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/* battery: bot
|
||||
*/
|
||||
{
|
||||
if ( u2_no == u2_rl_junior(bas_r, bat) ) {
|
||||
/* We need the jet battery to be in the shed, so that we
|
||||
** have a fast algorithm for distinguishing jet batteries
|
||||
** by ray address.
|
||||
*/
|
||||
bot = u2_rc(bas_r, u2_h(bat), u2_t(bat));
|
||||
#if 0
|
||||
printf("battery: in basket: %d.%x\n",
|
||||
u2_ray_a(u2_dog_a(bot)),
|
||||
u2_ray_b(u2_dog_a(bot)));
|
||||
#endif
|
||||
}
|
||||
else {
|
||||
bot = u2_rl_take(bas_r, bat);
|
||||
#if 0
|
||||
printf("battery: in shed! %d.%x\n",
|
||||
u2_ray_a(u2_dog_a(bot)),
|
||||
u2_ray_b(u2_dog_a(bot)));
|
||||
|
||||
#endif
|
||||
}
|
||||
if ( u2_none == bot ) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/* trunk: pet
|
||||
*/
|
||||
{
|
||||
if ( _0 == bud ) {
|
||||
pet = u2_nul;
|
||||
}
|
||||
else {
|
||||
u2_atom p_bud = u2_t(bud);
|
||||
u2_noun car = u2_frag(p_bud, cor);
|
||||
|
||||
if ( (u2_none == car) || (u2_no == u2_dust(car)) ) {
|
||||
break;
|
||||
} else {
|
||||
u2_noun but = u2_t(car);
|
||||
u2_noun xup, axe;
|
||||
|
||||
if ( u2_none == (xup = u2_ch_find(u2_bask_hag_r(bas_r), but)) ) {
|
||||
printf("no base!\n");
|
||||
u2_err(wir_r, "clu", clu);
|
||||
break;
|
||||
}
|
||||
else u2_rl_gain(bas_r, xup);
|
||||
|
||||
if ( u2_none == (axe = u2_rl_take(bas_r, p_bud)) ) {
|
||||
u2_rl_lose(bas_r, xup);
|
||||
}
|
||||
|
||||
if ( u2_none == (pet = u2_rc(bas_r, p_bud, xup)) ) {
|
||||
u2_rl_lose(bas_r, axe);
|
||||
u2_rl_lose(bas_r, xup);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* xop: new chip.
|
||||
*/
|
||||
{
|
||||
if ( u2_none == (xop = u2_rt(bas_r, dac, bot, pet)) ) {
|
||||
break;
|
||||
}
|
||||
if ( u2_none == (u2_ch_save(bas_r, u2_bask_hag_r(bas_r), bot, xop)) ) {
|
||||
break;
|
||||
}
|
||||
u2_rl_lose(bas_r, xop);
|
||||
}
|
||||
|
||||
/* cyr: new core.
|
||||
*/
|
||||
{
|
||||
u2_noun cyr;
|
||||
|
||||
if ( u2_none == (cyr = u2_rc(wir_r, u2_rx(wir_r, pay), bot)) ) {
|
||||
break;
|
||||
}
|
||||
else {
|
||||
u2_rl_lose(wir_r, cor);
|
||||
|
||||
return cyr;
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_ho_warn_here();
|
||||
#if 0
|
||||
// XXX: an unknown bug is triggered here;
|
||||
// but basket needs a minor rewrite.
|
||||
//
|
||||
if ( dac != u2_none ) u2_rl_lose(bas_r, dac);
|
||||
if ( bot != u2_none ) u2_rl_lose(bas_r, bot);
|
||||
if ( pet != u2_none ) u2_rl_lose(bas_r, pet);
|
||||
if ( xop != u2_none ) u2_rl_lose(bas_r, xop);
|
||||
#endif
|
||||
return cor;
|
||||
}
|
||||
}
|
||||
|
||||
/* _sh_good(): verify payload integrity in core.
|
||||
*/
|
||||
static u2_flag
|
||||
_sh_good(u2_noun cor,
|
||||
u2_noun xip)
|
||||
{
|
||||
#if 1
|
||||
return u2_yes; // Good! Ja! Everything good!
|
||||
#else
|
||||
while ( 1 ) {
|
||||
u2_noun bat = u2_h(u2_t(xip));
|
||||
u2_noun pet = u2_t(u2_t(xip));
|
||||
|
||||
if ( u2_no == u2_sing(bat, u2_t(cor)) ) {
|
||||
{
|
||||
char *cos_c = u2_ho_cstring(xip);
|
||||
|
||||
printf("sh: cos_c: %s\n", cos_c);
|
||||
}
|
||||
c3_assert(0);
|
||||
u2_ho_warn_here();
|
||||
return u2_no;
|
||||
}
|
||||
else {
|
||||
if ( _0 == pet ) {
|
||||
return u2_yes;
|
||||
} else {
|
||||
u2_atom axe = u2_h(pet);
|
||||
u2_noun nub = u2_frag(axe, cor);
|
||||
|
||||
if ( u2_none == nub ) {
|
||||
return u2_no;
|
||||
} else {
|
||||
cor = nub;
|
||||
xip = u2_t(pet);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/* u2_sh_find(): find chip by core.
|
||||
*/
|
||||
u2_weak
|
||||
u2_sh_find(u2_ray wir_r,
|
||||
u2_noun cor)
|
||||
{
|
||||
u2_ray bas_r;
|
||||
|
||||
if ( 0 == (bas_r = u2_wire_bas_r(wir_r)) ) {
|
||||
return u2_none;
|
||||
}
|
||||
if ( u2_no == u2_dust(cor) ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
u2_noun bat = u2_t(cor);
|
||||
|
||||
if ( !u2_fly_is_dog(bat) ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
u2_ray bat_r = u2_dog_a(bat);
|
||||
u2_ray rut_r = u2_rail_rut_r(bas_r);
|
||||
u2_ray hat_r = u2_rail_hat_r(bas_r);
|
||||
|
||||
if ( (bat_r < rut_r) || (bat_r >= hat_r) ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
u2_chip xip = u2_ch_find(u2_bask_hag_r(bas_r), bat);
|
||||
|
||||
if ( u2_none == xip ) {
|
||||
#if 0
|
||||
printf("bat_r %d.%x; hat_r %d.%x; rut_r %d.%x\n",
|
||||
u2_ray_a(bat_r), u2_ray_b(bat_r),
|
||||
u2_ray_a(hat_r), u2_ray_b(hat_r),
|
||||
u2_ray_a(rut_r), u2_ray_b(rut_r));
|
||||
u2_ho_warn_here();
|
||||
#endif
|
||||
return u2_none;
|
||||
} else {
|
||||
if ( u2_yes == _sh_good(cor, xip) ) {
|
||||
return xip;
|
||||
}
|
||||
else {
|
||||
u2_ho_warn_here();
|
||||
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_sh_cook():
|
||||
**
|
||||
** Produce hook formula from chip, or u2_none.
|
||||
*/
|
||||
u2_weak
|
||||
u2_sh_cook(u2_wire wir_r,
|
||||
u2_noun xip,
|
||||
const c3_c* tam_c)
|
||||
{
|
||||
u2_noun dac = u2_h(xip);
|
||||
u2_noun nut = u2_t(dac);
|
||||
|
||||
while ( u2_nul != nut ) {
|
||||
u2_noun i_nut = u2_h(nut);
|
||||
u2_noun t_nut = u2_t(nut);
|
||||
|
||||
if ( u2_yes == u2_sing_c(tam_c, u2_h(i_nut)) ) {
|
||||
return u2_t(i_nut);
|
||||
}
|
||||
else nut = t_nut;
|
||||
}
|
||||
return u2_none;
|
||||
}
|
||||
|
||||
/* u2_sh_look():
|
||||
**
|
||||
** Produce hook formula from core, or u2_none.
|
||||
*/
|
||||
u2_weak
|
||||
u2_sh_look(u2_wire wir_r,
|
||||
u2_noun cor,
|
||||
const c3_c* tam_c)
|
||||
{
|
||||
u2_ray bas_r = u2_wire_bas_r(wir_r);
|
||||
u2_noun bat = u2_t(cor);
|
||||
u2_noun fol;
|
||||
|
||||
if ( u2_none != (fol = u2_ch_find_mixt(u2_bask_hag_r(bas_r), tam_c, bat)) ) {
|
||||
return fol;
|
||||
} else {
|
||||
u2_noun xip = u2_sh_find(wir_r, cor);
|
||||
|
||||
if ( u2_none == xip ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
u2_axis axe_w = _1;
|
||||
|
||||
while ( 1 ) {
|
||||
fol = u2_sh_cook(wir_r, xip, tam_c);
|
||||
|
||||
if ( u2_none == fol ) {
|
||||
u2_noun pet = u2_t(u2_t(xip));
|
||||
|
||||
if ( _0 == pet ) {
|
||||
return u2_none;
|
||||
}
|
||||
else {
|
||||
u2_axis pax = u2_h(pet);
|
||||
|
||||
c3_assert(u2_fly_is_cat(pax));
|
||||
c3_assert((u2_ax_dep(axe_w) + u2_ax_dep(pax)) <= 30);
|
||||
|
||||
axe_w = u2_ax_peg(axe_w, pax);
|
||||
xip = u2_t(pet);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
else {
|
||||
fol = u2_rl_take(bas_r, fol);
|
||||
|
||||
if ( _1 != axe_w ) {
|
||||
/* XX: suboptimal; use comb:lily.
|
||||
*/
|
||||
fol = u2_rt(bas_r, u2_nock_flac,
|
||||
u2_rc(bas_r, u2_nock_frag, axe_w),
|
||||
fol);
|
||||
}
|
||||
fol = u2_ch_save_mixt(bas_r, u2_bask_hag_r(bas_r), tam_c, bat, fol);
|
||||
|
||||
return fol;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
748
f/trac.c
748
f/trac.c
@ -1,748 +0,0 @@
|
||||
/* f/trac.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include <sys/time.h>
|
||||
#include <sys/ioctl.h>
|
||||
#include <signal.h>
|
||||
#include <uv.h>
|
||||
#include <sigsegv.h>
|
||||
#include <curses.h>
|
||||
#include <termios.h>
|
||||
#include <term.h>
|
||||
|
||||
#include "v/vere.h"
|
||||
|
||||
/** Jet dependencies. Minimize these.
|
||||
**/
|
||||
# define Pt3Y k_164__mood__hoon
|
||||
# define Pt4Y k_164__mood__hoon
|
||||
|
||||
u2_noun
|
||||
j2_mbc(Pt3Y, gor)(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);
|
||||
|
||||
# define _tx_gor j2_mbc(Pt3Y, gor)
|
||||
# define _tx_put j2_mcc(Pt4Y, by, put)
|
||||
|
||||
|
||||
/** Static sampling data structures, for signal handling use.
|
||||
**/
|
||||
# define U2_TRAC_SAMPLE_MAX 10000
|
||||
|
||||
u2_loom_knot _tx_knots[U2_TRAC_SAMPLE_MAX];
|
||||
u2_loom_knot* _tx_top_k;
|
||||
u2_ray _tx_rac_r;
|
||||
c3_w _tx_knot_cur;
|
||||
c3_t _tx_on;
|
||||
|
||||
static u2_loom_knot*
|
||||
_tx_knot_new(void)
|
||||
{
|
||||
if ( _tx_knot_cur == U2_TRAC_SAMPLE_MAX ) {
|
||||
return 0;
|
||||
} else {
|
||||
u2_loom_knot *new_k = &_tx_knots[_tx_knot_cur];
|
||||
|
||||
_tx_knot_cur++;
|
||||
return new_k;
|
||||
}
|
||||
}
|
||||
|
||||
static u2_loom_knot*
|
||||
_tx_sample_in(u2_noun don)
|
||||
{
|
||||
if ( u2_nul == don ) {
|
||||
_tx_top_k->fin_w += 1;
|
||||
return _tx_top_k;
|
||||
}
|
||||
else {
|
||||
u2_noun hed = u2_h(don);
|
||||
c3_c hed_c[32];
|
||||
u2_loom_knot* par_k = _tx_sample_in(u2_t(don));
|
||||
u2_loom_knot* dis_k;
|
||||
|
||||
if ( (0 == par_k) && (u2_no == u2_stud(hed)) ) {
|
||||
return 0;
|
||||
}
|
||||
u2_bytes(0, 32, (c3_y *)hed_c, hed);
|
||||
hed_c[31] = 0;
|
||||
|
||||
for ( dis_k = par_k->fam_k; dis_k; dis_k = dis_k->nex_k ) {
|
||||
// linear search, should be fine in normal cases
|
||||
//
|
||||
if ( !strcmp(hed_c, dis_k->lic_c) ) {
|
||||
dis_k->fin_w += 1;
|
||||
return dis_k;
|
||||
}
|
||||
}
|
||||
if ( 0 == (dis_k = _tx_knot_new()) ) {
|
||||
return 0;
|
||||
} else {
|
||||
strncpy(dis_k->lic_c, hed_c, 31);
|
||||
dis_k->fin_w = 1;
|
||||
dis_k->fam_k = 0;
|
||||
dis_k->nex_k = par_k->fam_k;
|
||||
par_k->fam_k = dis_k;
|
||||
|
||||
return dis_k;
|
||||
}
|
||||
}
|
||||
}
|
||||
static void
|
||||
_tx_sample(c3_i x)
|
||||
{
|
||||
u2_ray rac_r = _tx_rac_r;
|
||||
|
||||
c3_assert(_tx_on == 1);
|
||||
// printf("sample sys %d\n", u2_trac_at(rac_r, wer.sys));
|
||||
|
||||
if ( u2_yes == u2_trac_at(rac_r, wer.sys) ) {
|
||||
if ( u2_yes == u2_trac_at(rac_r, wer.glu) ) {
|
||||
u2_trac_be(rac_r, c3_d, wer.com_d) += 1;
|
||||
} else {
|
||||
u2_trac_be(rac_r, c3_d, wer.jet_d) += 1;
|
||||
}
|
||||
} else {
|
||||
u2_trac_be(rac_r, c3_d, wer.erp_d) += 1;
|
||||
}
|
||||
|
||||
_tx_sample_in(u2_trac_at(rac_r, duz.don));
|
||||
}
|
||||
|
||||
/* u2_tx_samp_on(): turn profile sampling on, clear count.
|
||||
*/
|
||||
static void
|
||||
_tx_samp_on(u2_ray rac_r)
|
||||
{
|
||||
c3_assert(_tx_on == 0);
|
||||
c3_assert(_tx_knot_cur == 0);
|
||||
|
||||
_tx_on = 1;
|
||||
_tx_rac_r = rac_r;
|
||||
|
||||
_tx_top_k = _tx_knot_new();
|
||||
_tx_top_k->lic_c[0] = 0;
|
||||
_tx_top_k->fin_w = 0;
|
||||
_tx_top_k->fam_k = _tx_top_k->nex_k = 0;
|
||||
|
||||
{
|
||||
struct itimerval itm_v;
|
||||
struct sigaction sig_s;
|
||||
#if defined(U2_OS_osx)
|
||||
sig_s.__sigaction_u.__sa_handler = _tx_sample;
|
||||
sig_s.sa_mask = 0;
|
||||
sig_s.sa_flags = 0;
|
||||
#elif defined(U2_OS_linux)
|
||||
// TODO: support profiling on linux
|
||||
#elif defined(U2_OS_bsd)
|
||||
// TODO: support profiling on bsd
|
||||
#else
|
||||
#error "port: profiling"
|
||||
#endif
|
||||
sigaction(SIGPROF, &sig_s, 0);
|
||||
|
||||
itm_v.it_interval.tv_sec = 0;
|
||||
itm_v.it_interval.tv_usec = 10000;
|
||||
itm_v.it_value = itm_v.it_interval;
|
||||
|
||||
setitimer(ITIMER_PROF, &itm_v, 0);
|
||||
}
|
||||
}
|
||||
|
||||
/* _tx_samp_off(): turn profile sampling off.
|
||||
*/
|
||||
static void
|
||||
_tx_samp_off(u2_ray rac_r)
|
||||
{
|
||||
c3_assert(_tx_on == 1);
|
||||
struct sigaction sig_s;
|
||||
struct itimerval itm_v;
|
||||
|
||||
_tx_on = 0;
|
||||
_tx_knot_cur = 0;
|
||||
|
||||
itm_v.it_interval.tv_sec = 0;
|
||||
itm_v.it_interval.tv_usec = 0;
|
||||
itm_v.it_value = itm_v.it_interval;
|
||||
|
||||
setitimer(ITIMER_PROF, &itm_v, 0);
|
||||
|
||||
#if defined(U2_OS_osx)
|
||||
sig_s.__sigaction_u.__sa_handler = SIG_DFL;
|
||||
sig_s.sa_mask = 0;
|
||||
sig_s.sa_flags = 0;
|
||||
#elif defined(U2_OS_linux)
|
||||
// TODO: support profiling on linux
|
||||
#endif
|
||||
|
||||
sigaction(SIGPROF, &sig_s, 0);
|
||||
}
|
||||
|
||||
/* _tx_samples_in(): sample list.
|
||||
*/
|
||||
static u2_weak
|
||||
_tx_samples_in(u2_wire wir_r, u2_loom_knot *fam_k)
|
||||
{
|
||||
if ( 0 == fam_k ) {
|
||||
return u2_nul;
|
||||
} else {
|
||||
return u2_rc
|
||||
(wir_r, u2_rt(wir_r, u2_rl_string(wir_r, fam_k->lic_c),
|
||||
u2_rl_words(wir_r, 1, &fam_k->fin_w),
|
||||
_tx_samples_in(wir_r, fam_k->fam_k)),
|
||||
_tx_samples_in(wir_r, fam_k->nex_k));
|
||||
}
|
||||
}
|
||||
|
||||
/* _tx_samples(): dump samples.
|
||||
*/
|
||||
static u2_weak // produce
|
||||
_tx_samples(u2_wire wir_r)
|
||||
{
|
||||
u2_loom_knot *not_k = _tx_top_k;
|
||||
|
||||
return u2_rc(wir_r, u2_rl_words(wir_r, 1, ¬_k->fin_w),
|
||||
_tx_samples_in(wir_r, not_k->fam_k));
|
||||
}
|
||||
|
||||
/* _tx_d(): noun from c3_d.
|
||||
*/
|
||||
static u2_weak
|
||||
_tx_d(u2_wire wir_r, c3_d dat_d)
|
||||
{
|
||||
c3_w dat_w[2];
|
||||
|
||||
dat_w[0] = (dat_d & 0xffffffff);
|
||||
dat_w[1] = (dat_d >> 32ULL);
|
||||
|
||||
return u2_rl_words(wir_r, 2, dat_w);
|
||||
}
|
||||
|
||||
/* _tx_event(): add system counter to user event list.
|
||||
*/
|
||||
static u2_noun // produce
|
||||
_tx_event(u2_wire wir_r,
|
||||
c3_c* str_c,
|
||||
c3_d val_d,
|
||||
u2_noun cot) // submit
|
||||
{
|
||||
u2_noun vez, val, str;
|
||||
|
||||
if ( 0 == val_d ) {
|
||||
return cot;
|
||||
}
|
||||
if ( u2_none == (str = u2_rl_string(wir_r, str_c)) ) {
|
||||
return cot;
|
||||
}
|
||||
if ( u2_none == (val = _tx_d(wir_r, val_d)) ) {
|
||||
u2_rz(wir_r, str); return cot;
|
||||
}
|
||||
if ( u2_none == (vez = _tx_put(wir_r, cot, str, val)) ) {
|
||||
u2_rz(wir_r, str); u2_rz(wir_r, val); return cot;
|
||||
}
|
||||
u2_rz(wir_r, cot);
|
||||
return vez;
|
||||
}
|
||||
|
||||
/* u2_tx_events(): produce event list, including counts.
|
||||
*/
|
||||
static u2_noun // produce
|
||||
_tx_events(u2_wire wir_r,
|
||||
u2_noun cot) // retain
|
||||
{
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
|
||||
cot = u2_rx(wir_r, cot);
|
||||
|
||||
cot = _tx_event(wir_r, "sys-hops", u2_trac_be(rac_r, c3_d, sys.hop_d), cot);
|
||||
cot = _tx_event(wir_r, "sys-jets", u2_trac_be(rac_r, c3_d, sys.jet_d), cot);
|
||||
cot = _tx_event(wir_r, "sys-tests", u2_trac_be(rac_r, c3_d, sys.tes_d), cot);
|
||||
cot = _tx_event(wir_r, "sys-nods", u2_trac_be(rac_r, c3_d, sys.nod_d), cot);
|
||||
|
||||
cot = _tx_event(wir_r, "sys-cache-finds",
|
||||
u2_trac_be(rac_r, c3_d, sys.fin_d), cot);
|
||||
cot = _tx_event(wir_r, "sys-cache-saves",
|
||||
u2_trac_be(rac_r, c3_d, sys.pod_d), cot);
|
||||
|
||||
cot = _tx_event(wir_r, "sys-stack", u2_trac_at(rac_r, sys.cas_x.max_w), cot);
|
||||
|
||||
#if 0
|
||||
cot = _tx_event(wir_r, "sys-memory-used",
|
||||
u2_trac_be(rac_r, c3_w, sys.men_x.max_w), cot);
|
||||
cot = _tx_event(wir_r, "sys-memory-held",
|
||||
u2_trac_be(rac_r, c3_w, sys.men_x.med_w), cot);
|
||||
cot = _tx_event(wir_r, "sys-basket",
|
||||
u2_trac_be(rac_r, c3_w, sys.bek_x.max_w), cot);
|
||||
cot = _tx_event(wir_r, "sys-memory-active",
|
||||
4 * (u2_soup_liv_w(u2_rail_rut_r(wir_r)) -
|
||||
u2_trac_at(rac_r, sys.lif_w)),
|
||||
cot);
|
||||
|
||||
cot = _tx_event(wir_r, "sys-memory-basket",
|
||||
4 *
|
||||
(u2_soup_liv_w(u2_rail_rut_r(u2_wire_bas_r(wir_r))) -
|
||||
u2_trac_at(rac_r, sys.bos_w)),
|
||||
cot);
|
||||
#endif
|
||||
|
||||
#if 1
|
||||
// These numbers are bogus for some bizarre reason - non-random samples???
|
||||
//
|
||||
{
|
||||
c3_d com_d = u2_trac_be(rac_r, c3_d, wer.com_d);
|
||||
c3_d jet_d = u2_trac_be(rac_r, c3_d, wer.jet_d);
|
||||
c3_d erp_d = u2_trac_be(rac_r, c3_d, wer.erp_d);
|
||||
|
||||
// printf("com_d %llu, jet_d %llu, erp_d %llu\n", com_d, jet_d, erp_d);
|
||||
if ( com_d + erp_d + jet_d ) {
|
||||
c3_d sof_d = (erp_d * 100ULL) / (com_d + erp_d + jet_d);
|
||||
c3_d fun_d = (jet_d * 100ULL) / (com_d + erp_d + jet_d);
|
||||
|
||||
cot = _tx_event(wir_r, "sys-softpercent", sof_d, cot);
|
||||
cot = _tx_event(wir_r, "sys-jetpercent", fun_d, cot);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* sys-time
|
||||
*/
|
||||
{
|
||||
struct timeval tv;
|
||||
c3_w sec_w = u2_trac_at(rac_r, sys.sec_w);
|
||||
c3_w usc_w = u2_trac_at(rac_r, sys.usc_w);
|
||||
c3_w ums_w;
|
||||
c3_d old_d, new_d;
|
||||
|
||||
old_d = sec_w;
|
||||
old_d *= 1000000ULL;
|
||||
old_d += usc_w;
|
||||
|
||||
gettimeofday(&tv, 0);
|
||||
new_d = tv.tv_sec;
|
||||
new_d *= 1000000ULL;
|
||||
new_d += tv.tv_usec;
|
||||
|
||||
ums_w = (c3_w) (((new_d - old_d) + 999ULL) / 1000ULL);
|
||||
cot = _tx_event(wir_r, "sys-msec", ums_w, cot);
|
||||
}
|
||||
return cot;
|
||||
}
|
||||
|
||||
/* u2_tx_sys_bit(): set system bit, returning old value.
|
||||
*/
|
||||
u2_bean
|
||||
u2_tx_sys_bit(u2_ray wir_r, u2_bean val)
|
||||
{
|
||||
u2_bean bit = u2_wrac_at(wir_r, wer.sys);
|
||||
|
||||
u2_wrac_at(wir_r, wer.sys) = val;
|
||||
return bit;
|
||||
}
|
||||
|
||||
/* u2_tx_glu_bit(): set glutem bit, returning old value.
|
||||
*/
|
||||
u2_bean
|
||||
u2_tx_glu_bit(u2_ray wir_r, u2_bean val)
|
||||
{
|
||||
u2_bean bit = u2_wrac_at(wir_r, wer.glu);
|
||||
|
||||
u2_wrac_at(wir_r, wer.glu) = val;
|
||||
return bit;
|
||||
}
|
||||
|
||||
/* u2_tx_init(): initialize state.
|
||||
*/
|
||||
u2_ray
|
||||
u2_tx_init(u2_wire wir_r)
|
||||
{
|
||||
u2_ray rac_r = u2_rl_ralloc(wir_r, c3_wiseof(u2_loom_trac));
|
||||
|
||||
u2_trac_at(rac_r, cor.deb) = u2_no;
|
||||
u2_trac_at(rac_r, cor.pro) = u2_no;
|
||||
|
||||
return rac_r;
|
||||
}
|
||||
|
||||
/* u2_tx_open(): open/clear trace state.
|
||||
*/
|
||||
void
|
||||
u2_tx_open(u2_wire wir_r)
|
||||
{
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
|
||||
u2_trac_at(rac_r, wer.ryp) = u2_nul;
|
||||
u2_trac_at(rac_r, wer.sys) = u2_yes;
|
||||
u2_trac_at(rac_r, wer.glu) = u2_yes;
|
||||
u2_trac_be(rac_r, c3_d, wer.erp_d) = 0;
|
||||
u2_trac_be(rac_r, c3_d, wer.com_d) = 0;
|
||||
u2_trac_be(rac_r, c3_d, wer.jet_d) = 0;
|
||||
|
||||
u2_trac_at(rac_r, duz.don) = u2_nul;
|
||||
u2_trac_at(rac_r, duz.cot) = u2_nul;
|
||||
|
||||
u2_trac_be(rac_r, c3_d, sys.hop_d) = 0;
|
||||
u2_trac_be(rac_r, c3_d, sys.jet_d) = 0;
|
||||
u2_trac_be(rac_r, c3_d, sys.tes_d) = 0;
|
||||
u2_trac_be(rac_r, c3_d, sys.nod_d) = 0;
|
||||
u2_trac_be(rac_r, c3_d, sys.fin_d) = 0;
|
||||
u2_trac_be(rac_r, c3_d, sys.pod_d) = 0;
|
||||
|
||||
u2_trac_at(rac_r, sys.cas_x.med_w) =
|
||||
u2_trac_at(rac_r, sys.cas_x.max_w) = 0;
|
||||
|
||||
u2_trac_at(rac_r, sys.men_x.med_w) =
|
||||
u2_trac_at(rac_r, sys.men_x.max_w) = 0;
|
||||
|
||||
u2_trac_at(rac_r, sys.bek_x.med_w) =
|
||||
u2_trac_at(rac_r, sys.bek_x.max_w) = 0;
|
||||
|
||||
u2_trac_at(rac_r, sys.lif_w) = u2_soup_liv_w(u2_rail_rut_r(wir_r));
|
||||
u2_trac_at(rac_r, sys.bos_w) =
|
||||
u2_soup_liv_w(u2_rail_rut_r(u2_wire_bas_r(wir_r)));
|
||||
|
||||
{
|
||||
struct timeval tv;
|
||||
|
||||
gettimeofday(&tv, 0);
|
||||
u2_trac_at(rac_r, sys.sec_w) = tv.tv_sec;
|
||||
u2_trac_at(rac_r, sys.usc_w) = tv.tv_usec;
|
||||
}
|
||||
|
||||
if ( u2_yes == u2_trac_at(rac_r, cor.pro) ) {
|
||||
_tx_samp_on(rac_r);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_tx_done(): produce a profile slab to render. Free internal state.
|
||||
*/
|
||||
u2_noun // produce
|
||||
u2_tx_done(u2_wire wir_r)
|
||||
{
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
u2_noun p_sab = u2_nul, q_sab = u2_nul, r_sab = u2_nul;
|
||||
|
||||
if ( u2_yes == u2_trac_at(rac_r, cor.deb) ) {
|
||||
p_sab = u2_rx(wir_r, u2_trac_at(rac_r, wer.ryp));
|
||||
}
|
||||
if ( u2_yes == u2_trac_at(rac_r, cor.pro) ) {
|
||||
_tx_samp_off(rac_r);
|
||||
|
||||
q_sab = _tx_events(wir_r, u2_trac_at(rac_r, duz.cot));
|
||||
r_sab = _tx_samples(wir_r);
|
||||
|
||||
if ( u2_none == q_sab ) q_sab = u2_nul;
|
||||
if ( u2_none == r_sab ) r_sab = u2_nul;
|
||||
}
|
||||
u2_rz(wir_r, u2_trac_at(rac_r, wer.ryp));
|
||||
u2_rz(wir_r, u2_trac_at(rac_r, duz.don));
|
||||
u2_rz(wir_r, u2_trac_at(rac_r, duz.cot));
|
||||
|
||||
return u2_bt(wir_r, p_sab, q_sab, r_sab);
|
||||
}
|
||||
|
||||
/* u2_tx_do_debug(): set debug bean. Return old value.
|
||||
*/
|
||||
u2_bean
|
||||
u2_tx_do_debug(u2_ray wir_r, u2_bean lag)
|
||||
{
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
u2_bean old = u2_trac_at(rac_r, cor.deb);
|
||||
|
||||
u2_trac_at(rac_r, cor.deb) = lag;
|
||||
return old;
|
||||
}
|
||||
|
||||
/* u2_tx_in_debug(): get debug bean.
|
||||
*/
|
||||
u2_bean
|
||||
u2_tx_in_debug(u2_ray wir_r)
|
||||
{
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
|
||||
return u2_trac_at(rac_r, cor.deb);
|
||||
}
|
||||
|
||||
/* u2_tx_do_profile(): set profile bean. Return old value.
|
||||
*/
|
||||
u2_bean
|
||||
u2_tx_do_profile(u2_ray wir_r, u2_bean lag)
|
||||
{
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
u2_bean old = u2_trac_at(rac_r, cor.pro);
|
||||
|
||||
u2_trac_at(rac_r, cor.pro) = lag;
|
||||
return old;
|
||||
}
|
||||
|
||||
/* u2_tx_in_profile(): get profile bean.
|
||||
*/
|
||||
u2_bean
|
||||
u2_tx_in_profile(u2_ray wir_r)
|
||||
{
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
|
||||
return u2_trac_at(rac_r, cor.pro);
|
||||
}
|
||||
|
||||
static u2_bean
|
||||
_tx_map_ok(u2_wire wir_r,
|
||||
u2_noun a)
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_yes;
|
||||
} else {
|
||||
u2_noun l_a, n_a, r_a, lr_a;
|
||||
u2_noun pn_a, qn_a;
|
||||
|
||||
u2_as_cell(a, &n_a, &lr_a);
|
||||
u2_as_cell(lr_a, &l_a, &r_a);
|
||||
u2_as_cell(n_a, &pn_a, &qn_a);
|
||||
|
||||
c3_assert(l_a != a);
|
||||
c3_assert(r_a != a);
|
||||
|
||||
_tx_map_ok(wir_r, l_a);
|
||||
_tx_map_ok(wir_r, r_a);
|
||||
return u2_yes;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static u2_noun
|
||||
_tx_increment_soft(u2_wire wir_r,
|
||||
u2_noun a, // transfer
|
||||
u2_noun b) // retain
|
||||
{
|
||||
_tx_map_ok(wir_r, a);
|
||||
|
||||
if ( u2_nul == a ) {
|
||||
u2_noun nuu = u2_rt(wir_r, u2_rc(wir_r, u2_rx(wir_r, b), _1),
|
||||
u2_nul,
|
||||
u2_nul);
|
||||
if ( u2_none == nuu ) {
|
||||
return u2_nul;
|
||||
}
|
||||
else return nuu;
|
||||
} else {
|
||||
u2_noun l_a, n_a, r_a, lr_a;
|
||||
u2_noun pn_a, qn_a;
|
||||
|
||||
u2_as_cell(a, &n_a, &lr_a);
|
||||
u2_as_cell(lr_a, &l_a, &r_a);
|
||||
u2_as_cell(n_a, &pn_a, &qn_a);
|
||||
|
||||
if ( (u2_yes == u2_sing(b, pn_a)) ) {
|
||||
if ( u2_fly_is_cat(qn_a) && u2_fly_is_cat(qn_a + 1) ) {
|
||||
*u2_at_pom_tel(n_a) = (qn_a + 1);
|
||||
} else {
|
||||
u2_noun nyx = u2_rl_vint(wir_r, qn_a);
|
||||
|
||||
c3_assert(!"heavy increment");
|
||||
u2_rz(wir_r, qn_a);
|
||||
*u2_at_pom_tel(n_a) = nyx;
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == _tx_gor(wir_r, b, pn_a) ) {
|
||||
*u2_at_pom_hed(lr_a) = _tx_increment_soft(wir_r, l_a, b);
|
||||
} else {
|
||||
*u2_at_pom_tel(lr_a) = _tx_increment_soft(wir_r, r_a, b);
|
||||
}
|
||||
}
|
||||
return a;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_tx_did_act(): record user actions.
|
||||
*/
|
||||
void
|
||||
u2_tx_did_act(u2_wire wir_r,
|
||||
u2_noun did) // retain
|
||||
{
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
|
||||
if ( u2_yes == u2_trac_at(rac_r, cor.pro) ) {
|
||||
u2_noun cot = u2_trac_at(rac_r, duz.cot);
|
||||
|
||||
u2_trac_at(rac_r, duz.cot) = _tx_increment_soft(wir_r, cot, did);
|
||||
_tx_map_ok(wir_r, u2_trac_at(rac_r, duz.cot));
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_tx_task_in(): enter a task for profiling purposes.
|
||||
**
|
||||
** u2_yes iff the task is not already in the stack.
|
||||
*/
|
||||
u2_bean
|
||||
u2_tx_task_in(u2_wire wir_r,
|
||||
u2_noun tak) // retain
|
||||
{
|
||||
// Temporarily disabled due to bail issues.
|
||||
//
|
||||
#if 0
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
u2_noun don = u2_trac_at(rac_r, duz.don);
|
||||
u2_noun dim;
|
||||
|
||||
/* Test if we're already doing this.
|
||||
*/
|
||||
{
|
||||
dim = don;
|
||||
|
||||
while ( dim != u2_nul ) {
|
||||
if ( u2_yes == u2_sing(tak, u2_h(dim)) ) {
|
||||
return u2_no;
|
||||
}
|
||||
dim = u2_t(dim);
|
||||
}
|
||||
}
|
||||
|
||||
dim = u2_rc(wir_r, u2_rx(wir_r, tak), u2_rx(wir_r, don));
|
||||
if ( u2_none == dim ) {
|
||||
return u2_no;
|
||||
}
|
||||
else {
|
||||
u2_rz(wir_r, don);
|
||||
u2_trac_at(rac_r, duz.don) = dim;
|
||||
|
||||
return u2_yes;
|
||||
}
|
||||
#endif
|
||||
return u2_no;
|
||||
}
|
||||
|
||||
/* u2_tx_task_out(): leave a task for profiling purposes.
|
||||
*/
|
||||
void
|
||||
u2_tx_task_out(u2_wire wir_r)
|
||||
{
|
||||
// Temporarily disabled due to bail issues.
|
||||
//
|
||||
#if 0
|
||||
u2_ray rac_r = u2_wire_rac_r(wir_r);
|
||||
u2_noun don = u2_trac_at(rac_r, duz.don);
|
||||
u2_noun dim;
|
||||
|
||||
c3_assert((u2_nul != don) && (u2_yes == u2_dust(don)));
|
||||
dim = u2_t(don);
|
||||
u2_rx(wir_r, dim);
|
||||
u2_rz(wir_r, don);
|
||||
u2_trac_at(rac_r, duz.don) = dim;
|
||||
#endif
|
||||
}
|
||||
|
||||
#if 0
|
||||
/* _print_tape(): print a byte tape.
|
||||
*/
|
||||
static void
|
||||
_print_tape(u2_noun som,
|
||||
FILE* fil_F)
|
||||
{
|
||||
u2_noun h_som;
|
||||
|
||||
while ( (u2_yes == u2_dust(som)) && ((h_som = u2_h(som)) < 128) ) {
|
||||
putc(h_som, fil_F);
|
||||
som = u2_t(som);
|
||||
}
|
||||
}
|
||||
|
||||
/* _print_term(): print a terminal.
|
||||
*/
|
||||
static void
|
||||
_print_term(u2_noun som,
|
||||
FILE* fil_F)
|
||||
{
|
||||
if ( u2_yes == u2_stud(som) ) {
|
||||
c3_w len_w = u2_met(3, som);
|
||||
c3_y *som_y = alloca(len_w) + 1;
|
||||
|
||||
u2_bytes(0, len_w, som_y, som);
|
||||
som_y[len_w] = 0;
|
||||
fprintf(fil_F, "%s", (c3_c *)som_y);
|
||||
}
|
||||
}
|
||||
|
||||
/* _print_space(): print `feq_w` spaces.
|
||||
*/
|
||||
static void
|
||||
_print_space(c3_w feq_w,
|
||||
FILE* fil_F)
|
||||
{
|
||||
while ( feq_w-- ) {
|
||||
putc(' ', fil_F);
|
||||
}
|
||||
}
|
||||
|
||||
/* _print_wall(): print debug wall.
|
||||
*/
|
||||
static void
|
||||
_print_wall(u2_noun wal,
|
||||
FILE* fil_F)
|
||||
{
|
||||
while ( u2_yes == u2_dust(wal) ) {
|
||||
_print_tape(u2_h(wal), fil_F);
|
||||
putc('\r', fil_F);
|
||||
putc('\n', fil_F);
|
||||
wal = u2_t(wal);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef GHETTO
|
||||
c3_w nox_w;
|
||||
#endif
|
||||
|
||||
/* u2_tx_slog(): print debug syslog [0-3 tank] 0=debug 3=alarm
|
||||
*/
|
||||
void
|
||||
u2_tx_slog(u2_ray wir_r,
|
||||
u2_noun luf) // retain
|
||||
{
|
||||
#ifdef GHETTO
|
||||
struct timeval t;
|
||||
static struct timeval p;
|
||||
struct timeval d;
|
||||
static int haz;
|
||||
|
||||
gettimeofday(&t, 0);
|
||||
|
||||
if ( haz ) {
|
||||
c3_w ms_w;
|
||||
|
||||
timersub(&t, &p, &d);
|
||||
ms_w = (d.tv_sec * 1000) + (d.tv_usec / 1000);
|
||||
printf("%d.%dms (%d) ", ms_w, (d.tv_usec % 1000) / 10, nox_w);
|
||||
}
|
||||
haz = 1;
|
||||
nox_w = 0;
|
||||
#endif
|
||||
{
|
||||
if ( u2_yes == u2du(luf) ) {
|
||||
u2_noun pri = u2h(luf);
|
||||
|
||||
switch ( pri ) {
|
||||
case 3: printf(">>> "); break;
|
||||
case 2: printf(">> "); break;
|
||||
case 1: printf("> "); break;
|
||||
}
|
||||
u2_lo_tank(0, u2k(u2t(luf)));
|
||||
}
|
||||
}
|
||||
#ifdef GHETTO
|
||||
p = t;
|
||||
#endif
|
||||
}
|
||||
|
||||
/* u2_tx_warn(): report a warning by internal file and line.
|
||||
*/
|
||||
void
|
||||
u2_tx_warn(u2_ray wir_r,
|
||||
const c3_c* fil_c,
|
||||
c3_w lyn_w)
|
||||
{
|
||||
fprintf(stderr, "nock: warn: %s, %d\n", fil_c, lyn_w);
|
||||
}
|
||||
327
f/unix.c
327
f/unix.c
@ -1,327 +0,0 @@
|
||||
/* f/unix.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <dirent.h>
|
||||
#include <fcntl.h>
|
||||
#include <stdio.h>
|
||||
#include "all.h"
|
||||
|
||||
/* _unix_term(): u2_yes iff `tat` should be printed as a term.
|
||||
*/
|
||||
static u2_bean
|
||||
_unix_term(u2_atom tat)
|
||||
{
|
||||
c3_w met_w = u2_met(3, tat);
|
||||
|
||||
if ( met_w >= 2 ) {
|
||||
c3_y *buf_y = alloca(met_w);
|
||||
c3_w i_w;
|
||||
|
||||
u2_bytes(0, met_w, buf_y, tat);
|
||||
|
||||
for ( i_w=0; i_w < met_w; i_w++ ) {
|
||||
if ( ((buf_y[i_w] < 'a') || (buf_y[i_w] > 'x')) && (buf_y[i_w] != '-') ) {
|
||||
return u2_no;
|
||||
}
|
||||
}
|
||||
return u2_yes;
|
||||
}
|
||||
else return u2_no;
|
||||
}
|
||||
|
||||
static void _unix_dump(FILE*, u2_noun);
|
||||
|
||||
/* _unix_dump_in(): dump in cell to file.
|
||||
*/
|
||||
static void
|
||||
_unix_dump_in(FILE* fil,
|
||||
u2_noun som)
|
||||
{
|
||||
if ( u2_no == u2_dust(som) ) {
|
||||
_unix_dump(fil, som);
|
||||
}
|
||||
else {
|
||||
_unix_dump(fil, u2_h(som));
|
||||
fprintf(fil, " ");
|
||||
_unix_dump_in(fil, u2_t(som));
|
||||
}
|
||||
}
|
||||
|
||||
/* _unix_dump(): dump noun to file.
|
||||
*/
|
||||
static void
|
||||
_unix_dump(FILE* fil,
|
||||
u2_noun som)
|
||||
{
|
||||
if ( u2_no == u2_dust(som) ) {
|
||||
mpz_t amp;
|
||||
|
||||
if ( u2_yes == _unix_term(som) ) {
|
||||
c3_w met_w = u2_met(3, som);
|
||||
c3_y *buf_y = alloca(met_w + 1);
|
||||
|
||||
u2_bytes(0, met_w, buf_y, som);
|
||||
buf_y[met_w] = 0;
|
||||
fprintf(fil, "%%%s", buf_y);
|
||||
}
|
||||
else {
|
||||
u2_mp(amp, som);
|
||||
gmp_fprintf(fil, "%Zd", amp);
|
||||
mpz_clear(amp);
|
||||
}
|
||||
}
|
||||
else {
|
||||
fputc('[', fil);
|
||||
_unix_dump(fil, u2_h(som));
|
||||
fprintf(fil, " ");
|
||||
_unix_dump_in(fil, u2_t(som));
|
||||
fputc(']', fil);
|
||||
}
|
||||
}
|
||||
|
||||
static u2_noun _unix_scan(u2_wire, FILE*);
|
||||
|
||||
/* _unix_scan_cell(): scan cell or tuple.
|
||||
*/
|
||||
static u2_noun
|
||||
_unix_scan_cell(u2_wire wir_r,
|
||||
FILE* fil)
|
||||
{
|
||||
u2_noun hed = _unix_scan(wir_r, fil);
|
||||
c3_i c = fgetc(fil);
|
||||
|
||||
if ( c == ' ' ) {
|
||||
u2_noun tal = _unix_scan_cell(wir_r, fil);
|
||||
|
||||
return u2_bn_cell(wir_r, hed, tal);
|
||||
}
|
||||
else {
|
||||
c3_assert(c == ']');
|
||||
return hed;
|
||||
}
|
||||
}
|
||||
|
||||
/* _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_ux_read(): read a filesystem path/extension into an atom.
|
||||
*/
|
||||
u2_weak
|
||||
u2_ux_read(u2_ray wir_r,
|
||||
const c3_c* paf_c,
|
||||
const c3_c* ext_c)
|
||||
{
|
||||
c3_w len_w;
|
||||
c3_c* nam_c;
|
||||
|
||||
if ( ext_c )
|
||||
len_w = strlen(paf_c) + 1 + strlen(ext_c);
|
||||
else len_w = strlen(paf_c);
|
||||
|
||||
nam_c = alloca(len_w + 1);
|
||||
if ( ext_c ) {
|
||||
snprintf(nam_c, len_w + 1, "%s.%s", paf_c, ext_c);
|
||||
} else snprintf(nam_c, len_w + 1, "%s", paf_c);
|
||||
|
||||
{
|
||||
c3_i fid_i;
|
||||
struct stat sat_s;
|
||||
c3_w fln_w;
|
||||
c3_c* fil_c;
|
||||
u2_atom fil;
|
||||
|
||||
fid_i = open(nam_c, O_RDONLY, 0666);
|
||||
if ( (fid_i < 0) || (fstat(fid_i, &sat_s) < 0) ) {
|
||||
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_rl_bytes(wir_r, fln_w, (c3_y *)fil_c);
|
||||
free(fil_c);
|
||||
|
||||
return fil;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ux_read_deep(): read a filesystem path as a generic noun.
|
||||
*/
|
||||
u2_weak
|
||||
u2_ux_read_deep(u2_wire wir_r,
|
||||
const c3_c* paf_c,
|
||||
const c3_c* ext_c)
|
||||
{
|
||||
c3_w len_w;
|
||||
c3_c* nam_c;
|
||||
|
||||
if ( ext_c )
|
||||
len_w = strlen(paf_c) + 1 + strlen(ext_c);
|
||||
else len_w = strlen(paf_c);
|
||||
|
||||
nam_c = alloca(len_w + 1);
|
||||
if ( ext_c ) {
|
||||
snprintf(nam_c, len_w + 1, "%s.%s", paf_c, ext_c);
|
||||
} else snprintf(nam_c, len_w + 1, "%s", paf_c);
|
||||
|
||||
{
|
||||
FILE* fil;
|
||||
u2_noun som;
|
||||
|
||||
if ( !(fil = fopen(nam_c, "r")) ) {
|
||||
return u2_none;
|
||||
}
|
||||
som = _unix_scan(wir_r, fil);
|
||||
fclose(fil);
|
||||
return som;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ux_write(): write a path/extension as an atom.
|
||||
*/
|
||||
u2_bean
|
||||
u2_ux_write(u2_wire wir_r,
|
||||
u2_atom som,
|
||||
const c3_c* paf_c,
|
||||
const c3_c* ext_c)
|
||||
{
|
||||
c3_w len_w;
|
||||
c3_c* nam_c;
|
||||
|
||||
if ( ext_c )
|
||||
len_w = strlen(paf_c) + 1 + strlen(ext_c);
|
||||
else len_w = strlen(paf_c);
|
||||
|
||||
nam_c = alloca(len_w + 1);
|
||||
if ( ext_c ) {
|
||||
snprintf(nam_c, len_w + 1, "%s.%s", paf_c, ext_c);
|
||||
} else snprintf(nam_c, len_w + 1, "%s", paf_c);
|
||||
|
||||
{
|
||||
c3_i fid_i;
|
||||
c3_w fln_w;
|
||||
c3_y* fil_y;
|
||||
|
||||
fid_i = open(nam_c, O_WRONLY | O_CREAT, 0666);
|
||||
if ( fid_i < 0 ) {
|
||||
return u2_no;
|
||||
}
|
||||
fln_w = u2_met(3, som);
|
||||
fil_y = c3_malloc(fln_w);
|
||||
u2_bytes(0, fln_w, fil_y, som);
|
||||
|
||||
if ( fln_w != write(fid_i, fil_y, fln_w) ) {
|
||||
return u2_no;
|
||||
}
|
||||
close(fid_i);
|
||||
|
||||
return u2_yes;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ux_write_deep(): write a path/extension as a generic noun.
|
||||
*/
|
||||
u2_bean
|
||||
u2_ux_write_deep(u2_wire wir_r,
|
||||
u2_noun som,
|
||||
const c3_c* paf_c,
|
||||
const c3_c* ext_c)
|
||||
{
|
||||
c3_w len_w;
|
||||
c3_c* nam_c;
|
||||
|
||||
if ( ext_c )
|
||||
len_w = strlen(paf_c) + 1 + strlen(ext_c);
|
||||
else len_w = strlen(paf_c);
|
||||
|
||||
nam_c = alloca(len_w + 1);
|
||||
if ( ext_c ) {
|
||||
snprintf(nam_c, len_w + 1, "%s.%s", paf_c, ext_c);
|
||||
} else snprintf(nam_c, len_w + 1, "%s", paf_c);
|
||||
|
||||
{
|
||||
FILE* fil;
|
||||
|
||||
if ( !(fil = fopen(nam_c, "w")) ) {
|
||||
return u2_no;
|
||||
}
|
||||
_unix_dump(fil, som);
|
||||
fclose(fil);
|
||||
|
||||
return u2_yes;
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_ux_fresh(): true iff `oxt` is as fresh as `ext`.
|
||||
*/
|
||||
u2_bean
|
||||
u2_ux_fresh(const c3_c* paf_c,
|
||||
const c3_c* ext_c,
|
||||
const c3_c* oxt_c)
|
||||
{
|
||||
c3_w nam_w = strlen(paf_c) + 1 + strlen(ext_c);
|
||||
c3_w nom_w = strlen(paf_c) + 1 + strlen(oxt_c);
|
||||
c3_c* nam_c = alloca(nam_w + 1);
|
||||
c3_c* nom_c = alloca(nom_w + 1);
|
||||
struct stat nam_stat, nom_stat;
|
||||
|
||||
snprintf(nam_c, nam_w + 1, "%s.%s", paf_c, ext_c);
|
||||
snprintf(nom_c, nom_w + 1, "%s.%s", paf_c, oxt_c);
|
||||
|
||||
if ( stat(nam_c, &nam_stat) < 0 ) {
|
||||
return u2_no;
|
||||
}
|
||||
else {
|
||||
if ( (stat(nom_c, &nom_stat) < 0) ||
|
||||
#if defined(U2_OS_linux)
|
||||
(nam_stat.st_mtime > nom_stat.st_mtime)
|
||||
#elif defined(U2_OS_osx)
|
||||
(nam_stat.st_mtimespec.tv_sec > nom_stat.st_mtimespec.tv_sec) ||
|
||||
((nam_stat.st_mtimespec.tv_sec == (nam_stat.st_mtimespec.tv_sec)) &&
|
||||
(nam_stat.st_mtimespec.tv_nsec > nom_stat.st_mtimespec.tv_nsec))
|
||||
#elif defined(U2_OS_bsd)
|
||||
(nam_stat.st_mtim.tv_sec > nom_stat.st_mtim.tv_sec) ||
|
||||
((nam_stat.st_mtim.tv_sec == (nom_stat.st_mtim.tv_sec)) &&
|
||||
(nam_stat.st_mtim.tv_nsec > nom_stat.st_mtim.tv_nsec))
|
||||
#else
|
||||
#error "port: file time compare"
|
||||
#endif
|
||||
) {
|
||||
return u2_no;
|
||||
}
|
||||
else return u2_yes;
|
||||
}
|
||||
}
|
||||
276
f/wire.c
276
f/wire.c
@ -1,276 +0,0 @@
|
||||
/* f/wire.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include <sys/stat.h>
|
||||
#include <fcntl.h>
|
||||
|
||||
/* u2_wr_init():
|
||||
**
|
||||
** Install an empty wire within `hat_r` and `mat_r` in the loom,
|
||||
** with memory model `hip`.
|
||||
**
|
||||
** Returns ray to wire, which always equalls the passed `mat_r`.
|
||||
*/
|
||||
u2_ray
|
||||
u2_wr_init(c3_m hip_m,
|
||||
u2_ray hat_r,
|
||||
u2_ray mat_r)
|
||||
{
|
||||
u2_ray wir_r;
|
||||
|
||||
#if 0
|
||||
fprintf(stderr, "initial: hat_r %d, mat_r %d\r\n",
|
||||
hat_r >> LoomPageWords,
|
||||
mat_r >> LoomPageWords);
|
||||
#endif
|
||||
|
||||
wir_r = u2_rl_init(hip_m, hat_r, mat_r);
|
||||
u2_rail_hat_r(wir_r) += (c3_wiseof(u2_loom_wire) - c3_wiseof(u2_loom_rail));
|
||||
|
||||
#if 1
|
||||
u2_wire_bas_r(wir_r) = 0;
|
||||
#endif
|
||||
|
||||
u2_wire_kit_r(wir_r) = 0;
|
||||
|
||||
u2_cs_init(u2_wire_des_r(wir_r));
|
||||
|
||||
/* Trace stack, garbage.
|
||||
*/
|
||||
{
|
||||
u2_wire_tax(wir_r) = u2_nul;
|
||||
u2_wire_lan(wir_r) = u2_yes;
|
||||
}
|
||||
|
||||
/* Permanent basket = 1/8 of address space.
|
||||
*/
|
||||
{
|
||||
u2_ray bas_r;
|
||||
|
||||
bas_r = u2_rl_leap_part(wir_r, c3__sand, 1, 16, 0);
|
||||
u2_wire_bas_r(wir_r) = bas_r;
|
||||
|
||||
#if 0
|
||||
fprintf(stderr, "bas_r %d, hat %d, mat %d, cap %d, rut %d\n",
|
||||
bas_r >> LoomPageWords,
|
||||
u2_rail_hat_r(bas_r) >> LoomPageWords,
|
||||
u2_rail_mat_r(bas_r) >> LoomPageWords,
|
||||
u2_rail_cap_r(bas_r) >> LoomPageWords,
|
||||
u2_rail_rut_r(bas_r) >> LoomPageWords);
|
||||
|
||||
fprintf(stderr, "wir_r %d, hat %d, mat %d, cap %d, rut %d\n",
|
||||
wir_r >> LoomPageWords,
|
||||
u2_rail_hat_r(wir_r) >> LoomPageWords,
|
||||
u2_rail_mat_r(wir_r) >> LoomPageWords,
|
||||
u2_rail_cap_r(wir_r) >> LoomPageWords,
|
||||
u2_rail_rut_r(wir_r) >> LoomPageWords);
|
||||
|
||||
fprintf(stderr, "wir_r %x, hat %x, mat %x, cap %x, rut %x\n",
|
||||
wir_r ,
|
||||
u2_rail_hat_r(wir_r) ,
|
||||
u2_rail_mat_r(wir_r) ,
|
||||
u2_rail_cap_r(wir_r) ,
|
||||
u2_rail_rut_r(wir_r) );
|
||||
#endif
|
||||
|
||||
// u2_ba_init(wir_r, 0);
|
||||
}
|
||||
|
||||
#if 1
|
||||
/* Host control.
|
||||
*/
|
||||
{
|
||||
u2_ho_push();
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Basic performance tracking.
|
||||
*/
|
||||
{
|
||||
u2_wire_bex_r(wir_r) = u2_rl_ralloc(wir_r, c3_wiseof(u2_loom_benx));
|
||||
|
||||
u2_bx_boot(wir_r);
|
||||
}
|
||||
|
||||
/* New performance tracking.
|
||||
*/
|
||||
{
|
||||
u2_wire_rac_r(wir_r) = u2_tx_init(wir_r);
|
||||
}
|
||||
|
||||
/* Global namespace.
|
||||
*/
|
||||
{
|
||||
u2_wire_hev_r(wir_r) = u2_hv_init(wir_r);
|
||||
}
|
||||
|
||||
/* OS kernel.
|
||||
*/
|
||||
{
|
||||
u2_wire_arv_r(wir_r) = u2_rl_ralloc(wir_r, c3_wiseof(u2_reck));
|
||||
}
|
||||
|
||||
return wir_r;
|
||||
}
|
||||
|
||||
/* _wr_open(): open checkpoint file, or return null.
|
||||
*/
|
||||
static c3_i
|
||||
_wr_open(c3_c* cpu_c, c3_c* fil_c, c3_c* suf_c, c3_w len_w)
|
||||
{
|
||||
c3_c ful_c[8193];
|
||||
c3_i fid_i;
|
||||
|
||||
snprintf(ful_c, 8193, "%s", cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8193, "%s/.urb", cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8193, "%s/.urb/chk", cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8193, "%s/.urb/chk/%s.%s", cpu_c, fil_c, suf_c);
|
||||
fid_i = open(ful_c, O_RDWR | O_CREAT, 0666);
|
||||
if ( -1 == fid_i ) {
|
||||
perror(ful_c); exit(1);
|
||||
}
|
||||
if ( len_w &&
|
||||
(-1 == ftruncate(fid_i, (len_w * (1 << (LoomPageWords + 2))))) )
|
||||
{
|
||||
perror(ful_c); exit(1);
|
||||
}
|
||||
return fid_i;
|
||||
}
|
||||
|
||||
/* u2_wr_check_init(): initialize checkpoint segments and/or files.
|
||||
*/
|
||||
void
|
||||
u2_wr_check_init(c3_c* cpu_c)
|
||||
{
|
||||
// Segment A, low memory.
|
||||
//
|
||||
{
|
||||
LoomSegmentA.bot_w = 2048;
|
||||
LoomSegmentA.len_w = 30720;
|
||||
LoomSegmentA.pgs_w = 0;
|
||||
LoomSegmentA.ctl_i = _wr_open(cpu_c, "a", "ctl", 0);
|
||||
LoomSegmentA.dat_i = _wr_open(cpu_c, "a", "dat", LoomSegmentA.len_w);
|
||||
}
|
||||
|
||||
// Segment B, high memory.
|
||||
//
|
||||
{
|
||||
LoomSegmentB.bot_w = LoomHalfPages;
|
||||
LoomSegmentB.len_w = 30719;
|
||||
LoomSegmentB.pgs_w = 0;
|
||||
LoomSegmentB.ctl_i = _wr_open(cpu_c, "b", "ctl", 0);
|
||||
LoomSegmentB.dat_i = _wr_open(cpu_c, "b", "dat", LoomSegmentB.len_w);
|
||||
}
|
||||
|
||||
// Segment C, the basket control block. Ugly.
|
||||
{
|
||||
LoomSegmentC.bot_w = 63487;
|
||||
LoomSegmentC.len_w = 1;
|
||||
LoomSegmentC.pgs_w = 0;
|
||||
LoomSegmentC.ctl_i = _wr_open(cpu_c, "c", "ctl", 0);
|
||||
LoomSegmentC.dat_i = _wr_open(cpu_c, "c", "dat", LoomSegmentC.len_w);
|
||||
}
|
||||
|
||||
// Segment D, the actual basket.
|
||||
{
|
||||
LoomSegmentD.bot_w = 0;
|
||||
LoomSegmentD.len_w = 2048;
|
||||
LoomSegmentD.pgs_w = 0;
|
||||
LoomSegmentD.ctl_i = _wr_open(cpu_c, "d", "ctl", 0);
|
||||
LoomSegmentD.dat_i = _wr_open(cpu_c, "d", "dat", LoomSegmentD.len_w);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
_wr_check_cheg(u2_cheg* ceg_u, u2_ray top_r)
|
||||
{
|
||||
c3_w top_w = (top_r + ((1 << LoomPageWords) - 1)) >> LoomPageWords;
|
||||
|
||||
c3_assert(top_w >= ceg_u->bot_w);
|
||||
c3_assert(top_w < (ceg_u->bot_w + ceg_u->len_w));
|
||||
|
||||
if ( ceg_u->pgs_w > (top_w - ceg_u->bot_w) ) {
|
||||
ceg_u->pgs_w = (top_w - ceg_u->bot_w);
|
||||
}
|
||||
}
|
||||
|
||||
/* u2_wr_check_save(): checkpoint wire in global structure.
|
||||
*/
|
||||
void
|
||||
u2_wr_check_save()
|
||||
{
|
||||
u2_ray mat_r = u2_rail_mat_r(u2_Wire);
|
||||
u2_ray hat_r = u2_rail_hat_r(u2_Wire);
|
||||
|
||||
if ( hat_r >= HalfSize ) {
|
||||
_wr_check_cheg(&LoomSegmentB, hat_r);
|
||||
_wr_check_cheg(&LoomSegmentA, mat_r);
|
||||
} else {
|
||||
_wr_check_cheg(&LoomSegmentA, hat_r);
|
||||
_wr_check_cheg(&LoomSegmentB, mat_r);
|
||||
}
|
||||
#if 0
|
||||
_wr_check_cheg(&LoomSegmentC, u2_rail_hat_r(bas_r));
|
||||
#endif
|
||||
}
|
||||
|
||||
/* u2_wr_ice(): u2_rl_ice(), with u2_bx_copy().
|
||||
*/
|
||||
u2_weak
|
||||
u2_wr_ice(u2_ray wir_r,
|
||||
u2_noun fiz)
|
||||
{
|
||||
u2_ray hat_r = u2_rail_hat_r(wir_r);
|
||||
u2_noun buz;
|
||||
c3_w cop_w;
|
||||
|
||||
buz = u2_rl_ice(wir_r, fiz);
|
||||
|
||||
cop_w = u2_rail_hat_r(wir_r) - hat_r;
|
||||
if ( cop_w ) {
|
||||
u2_bx_copy(wir_r, cop_w);
|
||||
}
|
||||
return buz;
|
||||
}
|
||||
|
||||
/* u2_wr_mark():
|
||||
**
|
||||
** Mark all roots in a wire and return their allocation size.
|
||||
*/
|
||||
c3_w
|
||||
u2_wr_mark(u2_ray wir_r)
|
||||
{
|
||||
c3_w siz_w = 0;
|
||||
|
||||
c3_assert(c3__rock == u2_rail_hip_m(wir_r));
|
||||
{
|
||||
{
|
||||
u2_ray kit_r = u2_wire_kit_r(wir_r);
|
||||
|
||||
while ( kit_r ) {
|
||||
siz_w += u2_rl_gc_mark_ptr(wir_r, u2_wire_kit_r(wir_r));
|
||||
siz_w += u2_rl_gc_mark_noun(wir_r, u2_kite_tax(kit_r));
|
||||
siz_w += u2_rl_gc_mark_noun(wir_r, u2_kite_don(kit_r));
|
||||
|
||||
kit_r = u2_kite_par_r(kit_r);
|
||||
}
|
||||
}
|
||||
siz_w += u2_rl_gc_mark_ptr(wir_r, u2_wire_bex_r(wir_r));
|
||||
siz_w += u2_rl_gc_mark_ptr(wir_r, u2_wire_rac_r(wir_r));
|
||||
|
||||
siz_w += u2_rl_gc_mark_ptr(wir_r, u2_wire_hev_r(wir_r));
|
||||
siz_w += u2_rl_gc_mark_ptr(wir_r, u2_wire_arv_r(wir_r));
|
||||
u2_hv_mark();
|
||||
}
|
||||
siz_w += u2_rl_gc_mark(wir_r);
|
||||
|
||||
return siz_w;
|
||||
}
|
||||
994
g/e.c
Normal file
994
g/e.c
Normal file
@ -0,0 +1,994 @@
|
||||
/* g/e.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include <errno.h>
|
||||
#include <fcntl.h>
|
||||
#include <sys/stat.h>
|
||||
#include <sigsegv.h>
|
||||
#include <pmmintrin.h>
|
||||
#include <xmmintrin.h>
|
||||
|
||||
#include "all.h"
|
||||
|
||||
#if 0
|
||||
/* Image check.
|
||||
*/
|
||||
struct {
|
||||
c3_w nor_w;
|
||||
c3_w sou_w;
|
||||
c3_w mug_w[u3_cc_pages];
|
||||
} u3K;
|
||||
|
||||
/* _ce_check_page(): checksum page.
|
||||
*/
|
||||
static c3_w
|
||||
_ce_check_page(c3_w pag_w)
|
||||
{
|
||||
c3_w* mem_w = u3_Loom + (pag_w << u3_cc_page);
|
||||
c3_w mug_w = u3_cr_mug_words(mem_w, (1 << u3_cc_page));
|
||||
|
||||
return mug_w;
|
||||
}
|
||||
|
||||
/* u3_ce_check(): compute a checksum on all memory within the watermarks.
|
||||
*/
|
||||
void
|
||||
u3_ce_check(c3_c* cap_c)
|
||||
{
|
||||
c3_w nor_w = 0;
|
||||
c3_w sou_w = 0;
|
||||
|
||||
{
|
||||
c3_w nwr_w, swu_w;
|
||||
|
||||
u3_cm_water(&nwr_w, &swu_w);
|
||||
|
||||
nor_w = (nwr_w + ((1 << u3_cc_page) - 1)) >> u3_cc_page;
|
||||
sou_w = (swu_w + ((1 << u3_cc_page) - 1)) >> u3_cc_page;
|
||||
}
|
||||
|
||||
/* Count dirty pages.
|
||||
*/
|
||||
{
|
||||
c3_w i_w, sum_w, mug_w;
|
||||
|
||||
sum_w = 0;
|
||||
for ( i_w = 0; i_w < nor_w; i_w++ ) {
|
||||
mug_w = _ce_check_page(i_w);
|
||||
if ( strcmp(cap_c, "boot") ) {
|
||||
c3_assert(mug_w == u3K.mug_w[i_w]);
|
||||
}
|
||||
sum_w += mug_w;
|
||||
}
|
||||
for ( i_w = 0; i_w < sou_w; i_w++ ) {
|
||||
mug_w = _ce_check_page((u3_cc_pages - (i_w + 1)));
|
||||
if ( strcmp(cap_c, "boot") ) {
|
||||
c3_assert(mug_w == u3K.mug_w[(u3_cc_pages - (i_w + 1))]);
|
||||
}
|
||||
sum_w += mug_w;
|
||||
}
|
||||
printf("%s: sum %x (%x, %x)\r\n", cap_c, sum_w, nor_w, sou_w);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* u3_ce_fault(): handle a memory event with libsigsegv protocol.
|
||||
*/
|
||||
c3_i
|
||||
u3_ce_fault(void* adr_v, c3_i ser_i)
|
||||
{
|
||||
c3_w* adr_w = (c3_w*) adr_v;
|
||||
|
||||
if ( (adr_w < u3_Loom) || (adr_w > (u3_Loom + u3_cc_words)) ) {
|
||||
fprintf(stderr, "address %p out of loom!\r\n", adr_v);
|
||||
c3_assert(0);
|
||||
return 0;
|
||||
}
|
||||
else {
|
||||
c3_w off_w = (adr_w - u3_Loom);
|
||||
c3_w pag_w = off_w >> u3_cc_page;
|
||||
c3_w blk_w = (pag_w >> 5);
|
||||
c3_w bit_w = (pag_w & 31);
|
||||
|
||||
// printf("dirty page %d\r\n", pag_w);
|
||||
c3_assert(0 == (u3P.dit_w[blk_w] & (1 << bit_w)));
|
||||
u3P.dit_w[blk_w] |= (1 << bit_w);
|
||||
|
||||
if ( -1 == mprotect((void *)(u3_Loom + (pag_w << u3_cc_page)),
|
||||
(1 << (u3_cc_page + 2)),
|
||||
(PROT_READ | PROT_WRITE)) )
|
||||
{
|
||||
perror("mprotect");
|
||||
c3_assert(0);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* _ce_image_open(): open or create image.
|
||||
*/
|
||||
static c3_o
|
||||
_ce_image_open(u3_cs_image* img_u, c3_o nuu_o)
|
||||
{
|
||||
c3_i mod_i = u3_so(nuu_o) ? (O_RDWR | O_CREAT) : O_RDWR;
|
||||
c3_c ful_c[8193];
|
||||
|
||||
snprintf(ful_c, 8192, "%s", u3P.cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb", u3P.cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb/chk", u3P.cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb/chk/%s.bin", u3P.cpu_c, img_u->nam_c);
|
||||
if ( -1 == (img_u->fid_i = open(ful_c, mod_i, 0666)) ) {
|
||||
perror(ful_c);
|
||||
return u3_no;
|
||||
}
|
||||
else {
|
||||
struct stat buf_u;
|
||||
|
||||
if ( -1 == fstat(img_u->fid_i, &buf_u) ) {
|
||||
perror(ful_c);
|
||||
c3_assert(0);
|
||||
return u3_no;
|
||||
}
|
||||
else {
|
||||
c3_d siz_d = buf_u.st_size;
|
||||
c3_d pgs_d = (siz_d + (c3_d)((1 << (u3_cc_page + 2)) - 1)) >>
|
||||
(c3_d)(u3_cc_page + 2);
|
||||
|
||||
if ( u3_yes == nuu_o ) {
|
||||
if ( siz_d ) {
|
||||
c3_assert(0);
|
||||
return u3_no;
|
||||
}
|
||||
return u3_yes;
|
||||
}
|
||||
else {
|
||||
if ( siz_d != (pgs_d << (c3_d)(u3_cc_page + 2)) ) {
|
||||
fprintf(stderr, "%s: corrupt size %llx\r\n", ful_c, siz_d);
|
||||
return u3_no;
|
||||
}
|
||||
img_u->pgs_w = (c3_w) pgs_d;
|
||||
c3_assert(pgs_d == (c3_d)img_u->pgs_w);
|
||||
|
||||
return u3_yes;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _ce_patch_write_control(): write control block file.
|
||||
*/
|
||||
static void
|
||||
_ce_patch_write_control(u3_cs_patch* pat_u)
|
||||
{
|
||||
c3_w len_w = sizeof(u3_cs_control) +
|
||||
(pat_u->con_u->pgs_w * sizeof(u3_cs_line));
|
||||
|
||||
if ( len_w != write(pat_u->ctl_i, pat_u->con_u, len_w) ) {
|
||||
c3_assert(0);
|
||||
}
|
||||
}
|
||||
|
||||
/* _ce_patch_read_control(): read control block file.
|
||||
*/
|
||||
static c3_o
|
||||
_ce_patch_read_control(u3_cs_patch* pat_u)
|
||||
{
|
||||
c3_w len_w;
|
||||
|
||||
c3_assert(0 == pat_u->con_u);
|
||||
{
|
||||
struct stat buf_u;
|
||||
|
||||
if ( -1 == fstat(pat_u->ctl_i, &buf_u) ) {
|
||||
c3_assert(0);
|
||||
return u3_no;
|
||||
}
|
||||
len_w = (c3_w) buf_u.st_size;
|
||||
}
|
||||
|
||||
pat_u->con_u = malloc(len_w);
|
||||
if ( (len_w != read(pat_u->ctl_i, pat_u->con_u, len_w)) ||
|
||||
(len_w != sizeof(u3_cs_control) +
|
||||
(pat_u->con_u->pgs_w * sizeof(u3_cs_line))) )
|
||||
{
|
||||
free(pat_u->con_u);
|
||||
pat_u->con_u = 0;
|
||||
return u3_no;
|
||||
}
|
||||
return u3_yes;
|
||||
}
|
||||
|
||||
/* _ce_patch_create(): create patch files.
|
||||
*/
|
||||
static void
|
||||
_ce_patch_create(u3_cs_patch* pat_u)
|
||||
{
|
||||
c3_c ful_c[8193];
|
||||
|
||||
snprintf(ful_c, 8192, "%s", u3P.cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb", u3P.cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb/chk/control.bin", u3P.cpu_c);
|
||||
if ( -1 == (pat_u->ctl_i = open(ful_c, O_RDWR | O_CREAT | O_EXCL, 0666)) ) {
|
||||
c3_assert(0);
|
||||
}
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb/chk/memory.bin", u3P.cpu_c);
|
||||
if ( -1 == (pat_u->mem_i = open(ful_c, O_RDWR | O_CREAT | O_EXCL, 0666)) ) {
|
||||
c3_assert(0);
|
||||
}
|
||||
}
|
||||
|
||||
/* _ce_patch_delete(): delete a patch.
|
||||
*/
|
||||
static void
|
||||
_ce_patch_delete(void)
|
||||
{
|
||||
c3_c ful_c[8193];
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb/chk/control.bin", u3P.cpu_c);
|
||||
unlink(ful_c);
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb/chk/memory.bin", u3P.cpu_c);
|
||||
unlink(ful_c);
|
||||
}
|
||||
|
||||
/* _ce_patch_verify(): check patch data mug.
|
||||
*/
|
||||
static c3_o
|
||||
_ce_patch_verify(u3_cs_patch* pat_u)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < pat_u->con_u->pgs_w; i_w++ ) {
|
||||
c3_w pag_w = pat_u->con_u->mem_u[i_w].pag_w;
|
||||
c3_w mug_w = pat_u->con_u->mem_u[i_w].mug_w;
|
||||
c3_w mem_w[1 << u3_cc_page];
|
||||
|
||||
if ( -1 == lseek(pat_u->mem_i, (i_w << (u3_cc_page + 2)), SEEK_SET) ) {
|
||||
perror("seek");
|
||||
c3_assert(0);
|
||||
return u3_no;
|
||||
}
|
||||
if ( -1 == read(pat_u->mem_i, mem_w, (1 << (u3_cc_page + 2))) ) {
|
||||
perror("read");
|
||||
c3_assert(0);
|
||||
return u3_no;
|
||||
}
|
||||
{
|
||||
c3_w nug_w = u3_cr_mug_words(mem_w, (1 << u3_cc_page));
|
||||
|
||||
if ( mug_w != nug_w ) {
|
||||
printf("_ce_patch_verify: mug mismatch %d/%d; (%x, %x)\r\n",
|
||||
pag_w, i_w, mug_w, nug_w);
|
||||
c3_assert(0);
|
||||
return u3_no;
|
||||
}
|
||||
#if 0
|
||||
else {
|
||||
printf("verify: patch %d/%d, %x\r\n", pag_w, i_w, mug_w);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
}
|
||||
return u3_yes;
|
||||
}
|
||||
|
||||
/* _ce_patch_free(): free a patch.
|
||||
*/
|
||||
static void
|
||||
_ce_patch_free(u3_cs_patch* pat_u)
|
||||
{
|
||||
free(pat_u->con_u);
|
||||
close(pat_u->ctl_i);
|
||||
close(pat_u->mem_i);
|
||||
free(pat_u);
|
||||
}
|
||||
|
||||
/* _ce_patch_open(): open patch, if any.
|
||||
*/
|
||||
static u3_cs_patch*
|
||||
_ce_patch_open(void)
|
||||
{
|
||||
u3_cs_patch* pat_u;
|
||||
c3_c ful_c[8193];
|
||||
c3_i ctl_i, mem_i;
|
||||
|
||||
snprintf(ful_c, 8192, "%s", u3P.cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb", u3P.cpu_c);
|
||||
mkdir(ful_c, 0700);
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb/chk/control.bin", u3P.cpu_c);
|
||||
if ( -1 == (ctl_i = open(ful_c, O_RDWR)) ) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
snprintf(ful_c, 8192, "%s/.urb/chk/memory.bin", u3P.cpu_c);
|
||||
if ( -1 == (mem_i = open(ful_c, O_RDWR)) ) {
|
||||
close(ctl_i);
|
||||
|
||||
_ce_patch_delete();
|
||||
return 0;
|
||||
}
|
||||
pat_u = malloc(sizeof(u3_cs_patch));
|
||||
pat_u->ctl_i = ctl_i;
|
||||
pat_u->mem_i = mem_i;
|
||||
pat_u->con_u = 0;
|
||||
|
||||
if ( u3_no == _ce_patch_read_control(pat_u) ) {
|
||||
close(pat_u->ctl_i);
|
||||
close(pat_u->mem_i);
|
||||
free(pat_u);
|
||||
|
||||
_ce_patch_delete();
|
||||
return 0;
|
||||
}
|
||||
if ( u3_no == _ce_patch_verify(pat_u) ) {
|
||||
_ce_patch_free(pat_u);
|
||||
_ce_patch_delete();
|
||||
return 0;
|
||||
}
|
||||
return pat_u;
|
||||
}
|
||||
|
||||
/* _ce_patch_write_page(): write a page of patch memory.
|
||||
*/
|
||||
static void
|
||||
_ce_patch_write_page(u3_cs_patch* pat_u,
|
||||
c3_w pgc_w,
|
||||
c3_w* mem_w)
|
||||
{
|
||||
if ( -1 == lseek(pat_u->mem_i, (pgc_w << (u3_cc_page + 2)), SEEK_SET) ) {
|
||||
c3_assert(0);
|
||||
}
|
||||
if ( (1 << (u3_cc_page + 2)) !=
|
||||
write(pat_u->mem_i, mem_w, (1 << (u3_cc_page + 2))) )
|
||||
{
|
||||
c3_assert(0);
|
||||
}
|
||||
}
|
||||
|
||||
/* _ce_patch_count_page(): count a page, producing new counter.
|
||||
*/
|
||||
static c3_w
|
||||
_ce_patch_count_page(c3_w pag_w,
|
||||
c3_w pgc_w)
|
||||
{
|
||||
c3_w blk_w = (pag_w >> 5);
|
||||
c3_w bit_w = (pag_w & 31);
|
||||
|
||||
if ( u3P.dit_w[blk_w] & (1 << bit_w) ) {
|
||||
pgc_w += 1;
|
||||
}
|
||||
return pgc_w;
|
||||
}
|
||||
|
||||
/* _ce_patch_save_page(): save a page, producing new page counter.
|
||||
*/
|
||||
static c3_w
|
||||
_ce_patch_save_page(u3_cs_patch* pat_u,
|
||||
c3_w pag_w,
|
||||
c3_w pgc_w)
|
||||
{
|
||||
c3_w blk_w = (pag_w >> 5);
|
||||
c3_w bit_w = (pag_w & 31);
|
||||
|
||||
if ( u3P.dit_w[blk_w] & (1 << bit_w) ) {
|
||||
c3_w* mem_w = u3_Loom + (pag_w << u3_cc_page);
|
||||
|
||||
pat_u->con_u->mem_u[pgc_w].pag_w = pag_w;
|
||||
pat_u->con_u->mem_u[pgc_w].mug_w = u3_cr_mug_words(mem_w,
|
||||
(1 << u3_cc_page));
|
||||
|
||||
#if 0
|
||||
u3K.mug_w[pag_w] = pat_u->con_u->mem_u[pgc_w].mug_w;
|
||||
printf("save: page %d, mug %x\r\n",
|
||||
pag_w, u3_cr_mug_words(mem_w, (1 << u3_cc_page)));
|
||||
#endif
|
||||
_ce_patch_write_page(pat_u, pgc_w, mem_w);
|
||||
|
||||
if ( -1 == mprotect(u3_Loom + (pag_w << u3_cc_page),
|
||||
(1 << (u3_cc_page + 2)),
|
||||
PROT_READ) )
|
||||
{
|
||||
c3_assert(0);
|
||||
}
|
||||
|
||||
u3P.dit_w[blk_w] &= ~(1 << bit_w);
|
||||
pgc_w += 1;
|
||||
}
|
||||
return pgc_w;
|
||||
}
|
||||
|
||||
/* _ce_patch_junk_page(): mark a page as junk.
|
||||
*/
|
||||
static void
|
||||
_ce_patch_junk_page(u3_cs_patch* pat_u,
|
||||
c3_w pag_w)
|
||||
{
|
||||
c3_w blk_w = (pag_w >> 5);
|
||||
c3_w bit_w = (pag_w & 31);
|
||||
|
||||
if ( -1 == mprotect(u3_Loom + (pag_w << u3_cc_page),
|
||||
(1 << (u3_cc_page + 2)),
|
||||
PROT_READ) )
|
||||
{
|
||||
c3_assert(0);
|
||||
}
|
||||
u3P.dit_w[blk_w] &= ~(1 << bit_w);
|
||||
}
|
||||
|
||||
/* u3_ce_dirty(): count dirty pages.
|
||||
*/
|
||||
c3_w
|
||||
u3_ce_dirty(void)
|
||||
{
|
||||
c3_w pgs_w = 0;
|
||||
c3_w nor_w = 0;
|
||||
c3_w sou_w = 0;
|
||||
|
||||
/* Calculate number of saved pages, north and south.
|
||||
*/
|
||||
{
|
||||
c3_w nwr_w, swu_w;
|
||||
|
||||
u3_cm_water(&nwr_w, &swu_w);
|
||||
|
||||
nor_w = (nwr_w + ((1 << u3_cc_page) - 1)) >> u3_cc_page;
|
||||
sou_w = (swu_w + ((1 << u3_cc_page) - 1)) >> u3_cc_page;
|
||||
}
|
||||
// u3K.nor_w = nor_w;
|
||||
// u3K.sou_w = sou_w;
|
||||
|
||||
/* Count dirty pages.
|
||||
*/
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < nor_w; i_w++ ) {
|
||||
pgs_w = _ce_patch_count_page(i_w, pgs_w);
|
||||
}
|
||||
for ( i_w = 0; i_w < sou_w; i_w++ ) {
|
||||
pgs_w = _ce_patch_count_page((u3_cc_pages - (i_w + 1)), pgs_w);
|
||||
}
|
||||
}
|
||||
return pgs_w;
|
||||
}
|
||||
|
||||
/* _ce_patch_compose(): make and write current patch.
|
||||
*/
|
||||
static u3_cs_patch*
|
||||
_ce_patch_compose(void)
|
||||
{
|
||||
c3_w pgs_w = 0;
|
||||
c3_w nor_w = 0;
|
||||
c3_w sou_w = 0;
|
||||
|
||||
/* Calculate number of saved pages, north and south.
|
||||
*/
|
||||
{
|
||||
c3_w nwr_w, swu_w;
|
||||
|
||||
u3_cm_water(&nwr_w, &swu_w);
|
||||
|
||||
nor_w = (nwr_w + ((1 << u3_cc_page) - 1)) >> u3_cc_page;
|
||||
sou_w = (swu_w + ((1 << u3_cc_page) - 1)) >> u3_cc_page;
|
||||
}
|
||||
// u3K.nor_w = nor_w;
|
||||
// u3K.sou_w = sou_w;
|
||||
|
||||
/* Count dirty pages.
|
||||
*/
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < nor_w; i_w++ ) {
|
||||
pgs_w = _ce_patch_count_page(i_w, pgs_w);
|
||||
}
|
||||
for ( i_w = 0; i_w < sou_w; i_w++ ) {
|
||||
pgs_w = _ce_patch_count_page((u3_cc_pages - (i_w + 1)), pgs_w);
|
||||
}
|
||||
}
|
||||
|
||||
if ( !pgs_w ) {
|
||||
fprintf(stderr, "no dirty pages\r\n");
|
||||
return 0;
|
||||
}
|
||||
else {
|
||||
u3_cs_patch* pat_u = malloc(sizeof(u3_cs_patch));
|
||||
c3_w i_w, pgc_w;
|
||||
|
||||
_ce_patch_create(pat_u);
|
||||
pat_u->con_u = malloc(sizeof(u3_cs_control) + (pgs_w * sizeof(u3_cs_line)));
|
||||
pgc_w = 0;
|
||||
|
||||
for ( i_w = 0; i_w < nor_w; i_w++ ) {
|
||||
pgc_w = _ce_patch_save_page(pat_u, i_w, pgc_w);
|
||||
}
|
||||
for ( i_w = 0; i_w < sou_w; i_w++ ) {
|
||||
pgc_w = _ce_patch_save_page(pat_u, (u3_cc_pages - (i_w + 1)), pgc_w);
|
||||
}
|
||||
for ( i_w = nor_w; i_w < (u3_cc_pages - sou_w); i_w++ ) {
|
||||
_ce_patch_junk_page(pat_u, i_w);
|
||||
}
|
||||
|
||||
pat_u->con_u->nor_w = nor_w;
|
||||
pat_u->con_u->sou_w = sou_w;
|
||||
pat_u->con_u->pgs_w = pgc_w;
|
||||
|
||||
_ce_patch_write_control(pat_u);
|
||||
return pat_u;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ce_sync(): sync a file descriptor.
|
||||
*/
|
||||
static void
|
||||
_ce_sync(c3_i fid_i)
|
||||
{
|
||||
#if defined(U2_OS_linux)
|
||||
fdatasync(fid_i);
|
||||
#elif defined(U2_OS_osx)
|
||||
fcntl(fid_i, F_FULLFSYNC);
|
||||
#elif defined(U2_OS_bsd)
|
||||
fsync(fid_i);
|
||||
#else
|
||||
# error "port: datasync"
|
||||
#endif
|
||||
}
|
||||
|
||||
/* _ce_patch_sync(): make sure patch is synced to disk.
|
||||
*/
|
||||
static void
|
||||
_ce_patch_sync(u3_cs_patch* pat_u)
|
||||
{
|
||||
_ce_sync(pat_u->ctl_i);
|
||||
_ce_sync(pat_u->mem_i);
|
||||
}
|
||||
|
||||
/* _ce_image_sync(): make sure image is synced to disk.
|
||||
*/
|
||||
static void
|
||||
_ce_image_sync(u3_cs_image* img_u)
|
||||
{
|
||||
_ce_sync(img_u->fid_i);
|
||||
}
|
||||
|
||||
/* _ce_patch_apply(): apply patch to image.
|
||||
*/
|
||||
static void
|
||||
_ce_patch_apply(u3_cs_patch* pat_u)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
//printf("image: nor_w %d, new %d\r\n", u3P.nor_u.pgs_w, pat_u->con_u->nor_w);
|
||||
//printf("image: sou_w %d, new %d\r\n", u3P.sou_u.pgs_w, pat_u->con_u->sou_w);
|
||||
|
||||
if ( u3P.nor_u.pgs_w > pat_u->con_u->nor_w ) {
|
||||
ftruncate(u3P.nor_u.fid_i, u3P.nor_u.pgs_w << (u3_cc_page + 2));
|
||||
}
|
||||
u3P.nor_u.pgs_w = pat_u->con_u->nor_w;
|
||||
|
||||
if ( u3P.sou_u.pgs_w > pat_u->con_u->sou_w ) {
|
||||
ftruncate(u3P.sou_u.fid_i, u3P.sou_u.pgs_w << (u3_cc_page + 2));
|
||||
}
|
||||
u3P.sou_u.pgs_w = pat_u->con_u->sou_w;
|
||||
|
||||
if ( (-1 == lseek(pat_u->mem_i, 0, SEEK_SET)) ||
|
||||
(-1 == lseek(u3P.nor_u.fid_i, 0, SEEK_SET)) ||
|
||||
(-1 == lseek(u3P.sou_u.fid_i, 0, SEEK_SET)) )
|
||||
{
|
||||
perror("apply: seek");
|
||||
c3_assert(0);
|
||||
}
|
||||
|
||||
for ( i_w = 0; i_w < pat_u->con_u->pgs_w; i_w++ ) {
|
||||
c3_w pag_w = pat_u->con_u->mem_u[i_w].pag_w;
|
||||
c3_w mem_w[1 << u3_cc_page];
|
||||
c3_i fid_i;
|
||||
c3_w off_w;
|
||||
|
||||
if ( pag_w < pat_u->con_u->nor_w ) {
|
||||
fid_i = u3P.nor_u.fid_i;
|
||||
off_w = pag_w;
|
||||
}
|
||||
else {
|
||||
fid_i = u3P.sou_u.fid_i;
|
||||
off_w = (u3_cc_pages - (pag_w + 1));
|
||||
}
|
||||
|
||||
if ( -1 == read(pat_u->mem_i, mem_w, (1 << (u3_cc_page + 2))) ) {
|
||||
perror("apply: read");
|
||||
c3_assert(0);
|
||||
}
|
||||
else {
|
||||
if ( -1 == lseek(fid_i, (off_w << (u3_cc_page + 2)), SEEK_SET) ) {
|
||||
perror("apply: lseek");
|
||||
c3_assert(0);
|
||||
}
|
||||
if ( -1 == write(fid_i, mem_w, (1 << (u3_cc_page + 2))) ) {
|
||||
perror("apply: write");
|
||||
c3_assert(0);
|
||||
}
|
||||
}
|
||||
#if 0
|
||||
printf("apply: %d, %x\n", pag_w, u3_cr_mug_words(mem_w, (1 << u3_cc_page)));
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
/* _ce_image_blit(): apply image to memory.
|
||||
*/
|
||||
static void
|
||||
_ce_image_blit(u3_cs_image* img_u,
|
||||
c3_w* ptr_w,
|
||||
c3_ws stp_ws)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
lseek(img_u->fid_i, 0, SEEK_SET);
|
||||
for ( i_w=0; i_w < img_u->pgs_w; i_w++ ) {
|
||||
if ( -1 == read(img_u->fid_i, ptr_w, (1 << (u3_cc_page + 2))) ) {
|
||||
perror("read");
|
||||
c3_assert(0);
|
||||
}
|
||||
#if 0
|
||||
{
|
||||
c3_w off_w = (ptr_w - u3_Loom);
|
||||
c3_w pag_w = (off_w >> u3_cc_page);
|
||||
|
||||
printf("blit: page %d, mug %x\r\n", pag_w,
|
||||
u3_cr_mug_words(ptr_w, (1 << u3_cc_page)));
|
||||
}
|
||||
#endif
|
||||
ptr_w += stp_ws;
|
||||
}
|
||||
}
|
||||
|
||||
#if 0
|
||||
/* _ce_image_fine(): compare image to memory.
|
||||
*/
|
||||
static void
|
||||
_ce_image_fine(u3_cs_image* img_u,
|
||||
c3_w* ptr_w,
|
||||
c3_ws stp_ws)
|
||||
{
|
||||
c3_w i_w;
|
||||
c3_w buf_w[1 << u3_cc_page];
|
||||
|
||||
lseek(img_u->fid_i, 0, SEEK_SET);
|
||||
for ( i_w=0; i_w < img_u->pgs_w; i_w++ ) {
|
||||
c3_w mem_w, fil_w;
|
||||
|
||||
if ( -1 == read(img_u->fid_i, buf_w, (1 << (u3_cc_page + 2))) ) {
|
||||
perror("read");
|
||||
c3_assert(0);
|
||||
}
|
||||
mem_w = u3_cr_mug_words(ptr_w, (1 << u3_cc_page));
|
||||
fil_w = u3_cr_mug_words(buf_w, (1 << u3_cc_page));
|
||||
|
||||
if ( mem_w != fil_w ) {
|
||||
c3_w pag_w = (ptr_w - u3_Loom) >> u3_cc_page;
|
||||
|
||||
fprintf(stderr, "mismatch: page %d, mem_w %x, fil_w %x, K %x\r\n",
|
||||
pag_w,
|
||||
mem_w,
|
||||
fil_w,
|
||||
u3K.mug_w[pag_w]);
|
||||
abort();
|
||||
}
|
||||
ptr_w += stp_ws;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* u3_ce_save(): save current changes.
|
||||
*/
|
||||
void
|
||||
u3_ce_save(void)
|
||||
{
|
||||
u3_cs_patch* pat_u;
|
||||
|
||||
// Write all dirty pages to disk; clear protection and dirty bits.
|
||||
//
|
||||
// This has to block the main thread. All further processing can happen
|
||||
// in a separate thread, though we can't save again till this completes.
|
||||
//
|
||||
|
||||
if ( !(pat_u = _ce_patch_compose()) ) {
|
||||
return;
|
||||
}
|
||||
|
||||
// Sync the patch files.
|
||||
//
|
||||
// u3_ca_print_memory("sync: save", 4096 * pat_u->con_u->pgs_w);
|
||||
_ce_patch_sync(pat_u);
|
||||
|
||||
// Verify the patch - because why not?
|
||||
//
|
||||
// printf("_ce_patch_verify\r\n");
|
||||
_ce_patch_verify(pat_u);
|
||||
|
||||
// Write the patch data into the image file. Idempotent.
|
||||
//
|
||||
// printf("_ce_patch_apply\r\n");
|
||||
_ce_patch_apply(pat_u);
|
||||
|
||||
#if 0
|
||||
{
|
||||
_ce_image_fine(&u3P.nor_u,
|
||||
u3_Loom,
|
||||
(1 << u3_cc_page));
|
||||
|
||||
_ce_image_fine(&u3P.sou_u,
|
||||
(u3_Loom + (1 << u3_cc_bits) - (1 << u3_cc_page)),
|
||||
-(1 << u3_cc_page));
|
||||
|
||||
c3_assert(u3P.nor_u.pgs_w == u3K.nor_w);
|
||||
c3_assert(u3P.sou_u.pgs_w == u3K.sou_w);
|
||||
}
|
||||
#endif
|
||||
|
||||
// Sync the image file.
|
||||
//
|
||||
// printf("_ce_image_sync\r\n");
|
||||
_ce_image_sync(&u3P.nor_u);
|
||||
_ce_image_sync(&u3P.sou_u);
|
||||
|
||||
// Delete the patchfile and free it.
|
||||
//
|
||||
// printf("_ce_patch_delete\r\n");
|
||||
_ce_patch_delete();
|
||||
// printf("_ce_patch_free\r\n");
|
||||
_ce_patch_free(pat_u);
|
||||
}
|
||||
|
||||
/* _ce_limits(): set up global modes and limits.
|
||||
*/
|
||||
static void
|
||||
_ce_limits(void)
|
||||
{
|
||||
struct rlimit rlm;
|
||||
c3_i ret_i;
|
||||
|
||||
/* Set compatible floating-point modes.
|
||||
*/
|
||||
{
|
||||
_MM_SET_FLUSH_ZERO_MODE(_MM_FLUSH_ZERO_ON);
|
||||
_MM_SET_DENORMALS_ZERO_MODE(_MM_DENORMALS_ZERO_ON);
|
||||
}
|
||||
|
||||
/* Moar stack.
|
||||
*/
|
||||
{
|
||||
ret_i = getrlimit(RLIMIT_STACK, &rlm);
|
||||
c3_assert(0 == ret_i);
|
||||
rlm.rlim_cur = (rlm.rlim_max > (65536 << 10))
|
||||
? (65536 << 10)
|
||||
: rlm.rlim_max;
|
||||
if ( 0 != setrlimit(RLIMIT_STACK, &rlm) ) {
|
||||
perror("stack");
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
/* Moar filez.
|
||||
*/
|
||||
{
|
||||
ret_i = getrlimit(RLIMIT_NOFILE, &rlm);
|
||||
c3_assert(0 == ret_i);
|
||||
rlm.rlim_cur = 4096;
|
||||
if ( 0 != setrlimit(RLIMIT_NOFILE, &rlm) ) {
|
||||
perror("file limit");
|
||||
// no exit, not a critical limit
|
||||
}
|
||||
}
|
||||
|
||||
/* Moar core.
|
||||
*/
|
||||
{
|
||||
getrlimit(RLIMIT_CORE, &rlm);
|
||||
rlm.rlim_cur = RLIM_INFINITY;
|
||||
if ( 0 != setrlimit(RLIMIT_CORE, &rlm) ) {
|
||||
perror("core limit");
|
||||
// no exit, not a critical limit
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _ce_signals(): set up interrupts, etc.
|
||||
*/
|
||||
static void
|
||||
_ce_signals(void)
|
||||
{
|
||||
if ( 0 != sigsegv_install_handler(u3_ce_fault) ) {
|
||||
fprintf(stderr, "sigsegv install failed\n");
|
||||
exit(1);
|
||||
}
|
||||
// signal(SIGINT, _loom_stop);
|
||||
}
|
||||
|
||||
/* u3_ce_init(): start the environment, with/without checkpointing.
|
||||
*/
|
||||
void
|
||||
u3_ce_init(c3_o chk_o)
|
||||
{
|
||||
_ce_limits();
|
||||
_ce_signals();
|
||||
|
||||
/* Map at fixed address.
|
||||
*/
|
||||
{
|
||||
c3_w len_w = u3_cc_bytes;
|
||||
void* map_v;
|
||||
|
||||
map_v = mmap((void *)u3_Loom,
|
||||
len_w,
|
||||
u3_so(chk_o) ? PROT_READ : (PROT_READ | PROT_WRITE),
|
||||
(MAP_ANON | MAP_FIXED | MAP_PRIVATE),
|
||||
-1, 0);
|
||||
|
||||
if ( -1 == (c3_ps)map_v ) {
|
||||
map_v = mmap((void *)0,
|
||||
len_w,
|
||||
PROT_READ,
|
||||
MAP_ANON | MAP_PRIVATE,
|
||||
-1, 0);
|
||||
|
||||
if ( -1 == (c3_ps)map_v ) {
|
||||
fprintf(stderr, "boot: map failed twice\r\n");
|
||||
} else {
|
||||
fprintf(stderr, "boot: map failed - try U2_OS_LoomBase %p\r\n", map_v);
|
||||
}
|
||||
exit(1);
|
||||
}
|
||||
printf("loom: mapped %dMB\r\n", len_w >> 20);
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ce_grab(): garbage-collect the world, plus extra roots, then
|
||||
*/
|
||||
void
|
||||
u3_ce_grab(c3_c* cap_c, u3_noun som, ...) // terminate with u3_none
|
||||
{
|
||||
// u3_ch_free(u3R->cax.har_p);
|
||||
// u3R->cax.har_p = u3_ch_new();
|
||||
|
||||
u3_cv_mark();
|
||||
u3_cm_mark();
|
||||
{
|
||||
va_list vap;
|
||||
u3_noun tur;
|
||||
|
||||
va_start(vap, som);
|
||||
|
||||
if ( som != u3_none ) {
|
||||
u3_ca_mark_noun(som);
|
||||
|
||||
while ( u3_none != (tur = va_arg(vap, u3_noun)) ) {
|
||||
u3_ca_mark_noun(tur);
|
||||
}
|
||||
}
|
||||
va_end(vap);
|
||||
}
|
||||
u3_ca_sweep(cap_c);
|
||||
}
|
||||
|
||||
/* u3_ce_boot(): start the u3 system.
|
||||
*/
|
||||
void
|
||||
u3_ce_boot(c3_o nuu_o, c3_o bug_o, c3_c* cpu_c)
|
||||
{
|
||||
u3_ce_init(nuu_o);
|
||||
|
||||
u3P.cpu_c = cpu_c;
|
||||
u3P.nor_u.nam_c = "north";
|
||||
u3P.sou_u.nam_c = "south";
|
||||
|
||||
/* Open and apply any patches.
|
||||
*/
|
||||
if ( u3_so(nuu_o) ) {
|
||||
if ( (u3_no == _ce_image_open(&u3P.nor_u, u3_yes)) ||
|
||||
(u3_no == _ce_image_open(&u3P.sou_u, u3_yes)) )
|
||||
{
|
||||
printf("boot: image failed\r\n");
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
else {
|
||||
u3_cs_patch* pat_u;
|
||||
|
||||
/* Open image files.
|
||||
*/
|
||||
{
|
||||
if ( (u3_no == _ce_image_open(&u3P.nor_u, u3_no)) ||
|
||||
(u3_no == _ce_image_open(&u3P.sou_u, u3_no)) )
|
||||
{
|
||||
fprintf(stderr, "boot: no image\r\n");
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
/* Load any patch files; apply them to images.
|
||||
*/
|
||||
if ( 0 != (pat_u = _ce_patch_open()) ) {
|
||||
printf("_ce_patch_apply\r\n");
|
||||
_ce_patch_apply(pat_u);
|
||||
|
||||
printf("_ce_image_sync\r\n");
|
||||
_ce_image_sync(&u3P.nor_u);
|
||||
_ce_image_sync(&u3P.sou_u);
|
||||
|
||||
printf("_ce_patch_delete\r\n");
|
||||
_ce_patch_delete();
|
||||
printf("_ce_patch_free\r\n");
|
||||
_ce_patch_free(pat_u);
|
||||
}
|
||||
|
||||
/* Write image files to memory; reinstate protection.
|
||||
*/
|
||||
{
|
||||
_ce_image_blit(&u3P.nor_u,
|
||||
u3_Loom,
|
||||
(1 << u3_cc_page));
|
||||
|
||||
_ce_image_blit(&u3P.sou_u,
|
||||
(u3_Loom + (1 << u3_cc_bits) - (1 << u3_cc_page)),
|
||||
-(1 << u3_cc_page));
|
||||
|
||||
if ( 0 != mprotect((void *)u3_Loom, u3_cc_bytes, PROT_READ) ) {
|
||||
perror("protect");
|
||||
c3_assert(0);
|
||||
}
|
||||
printf("protected loom\r\n");
|
||||
}
|
||||
|
||||
/* If the images were empty, we are logically booting.
|
||||
*/
|
||||
if ( (0 == u3P.nor_u.pgs_w) && (0 == u3P.sou_u.pgs_w) ) {
|
||||
printf("logical boot\r\n");
|
||||
nuu_o = u3_yes;
|
||||
}
|
||||
}
|
||||
|
||||
/* Construct or activate the allocator.
|
||||
*/
|
||||
u3_cm_boot(nuu_o, bug_o);
|
||||
|
||||
/* Initialize the jet system.
|
||||
*/
|
||||
u3_cj_boot();
|
||||
|
||||
/* Install the kernel.
|
||||
*/
|
||||
if ( u3_so(nuu_o) ) {
|
||||
c3_c pas_c[2049];
|
||||
struct stat buf_u;
|
||||
|
||||
snprintf(pas_c, 2048, "%s/.urb/urbit.pill", cpu_c);
|
||||
if ( -1 == stat(pas_c, &buf_u) ) {
|
||||
snprintf(pas_c, 2048, "%s/urbit.pill", U2_LIB);
|
||||
}
|
||||
printf("boot: loading %s\r\n", pas_c);
|
||||
u3_cv_make(pas_c);
|
||||
|
||||
u3_cv_jack();
|
||||
}
|
||||
else {
|
||||
u3_cv_hose();
|
||||
u3_cj_ream();
|
||||
}
|
||||
}
|
||||
685
g/h.c
Normal file
685
g/h.c
Normal file
@ -0,0 +1,685 @@
|
||||
/* g/h.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
static void* _ch_some_add(void* han_v, c3_w, c3_w, u3_noun);
|
||||
static void* _ch_some_new(c3_w lef_w);
|
||||
|
||||
/* u3_ch_new(): create hashtable.
|
||||
*/
|
||||
u3p(u3_ch_root)
|
||||
u3_ch_new(void)
|
||||
{
|
||||
u3_ch_root* har_u = u3_ca_walloc(c3_wiseof(u3_ch_root));
|
||||
u3p(u3_ch_root) har_p = u3of(u3_ch_root, har_u);
|
||||
c3_w i_w;
|
||||
|
||||
har_u->clk_w = 0;
|
||||
for ( i_w = 0; i_w < 64; i_w++ ) {
|
||||
har_u->sot_w[i_w] = 0;
|
||||
}
|
||||
return har_p;
|
||||
}
|
||||
|
||||
/* _ch_popcount(): number of bits set in word. A standard intrinsic.
|
||||
*/
|
||||
static c3_w
|
||||
_ch_popcount(c3_w num_w)
|
||||
{
|
||||
return __builtin_popcount(num_w);
|
||||
}
|
||||
|
||||
/* _ch_buck_new(): create new, empty bucket.
|
||||
*/
|
||||
static u3_ch_buck*
|
||||
_ch_buck_new(void)
|
||||
{
|
||||
u3_ch_buck* hab_u = u3_ca_walloc(c3_wiseof(u3_ch_buck));
|
||||
|
||||
hab_u->len_w = 0;
|
||||
return hab_u;
|
||||
}
|
||||
|
||||
/* ha_buck_add(): add to bucket.
|
||||
*/
|
||||
static u3_ch_buck*
|
||||
_ch_buck_add(u3_ch_buck* hab_u, u3_noun kev)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < hab_u->len_w; i_w++ ) {
|
||||
if ( u3_yes == u3_cr_sing(u3h(kev), u3h(hab_u->kev[i_w])) ) {
|
||||
u3_ca_lose(hab_u->kev[i_w]);
|
||||
hab_u->kev[i_w] = kev;
|
||||
|
||||
return hab_u;
|
||||
}
|
||||
}
|
||||
|
||||
{
|
||||
c3_w len_w = hab_u->len_w;
|
||||
u3_ch_buck* bah_u = u3_ca_walloc(c3_wiseof(u3_ch_buck) +
|
||||
(len_w + 1) * c3_wiseof(u3_noun));
|
||||
|
||||
bah_u->len_w = len_w + 1;
|
||||
bah_u->kev[0] = kev;
|
||||
|
||||
// Optimize: use u3_ca_wealloc().
|
||||
//
|
||||
for ( i_w = 0; i_w < hab_u->len_w; i_w++ ) {
|
||||
bah_u->kev[i_w + 1] = hab_u->kev[i_w];
|
||||
}
|
||||
|
||||
u3_ca_free(hab_u);
|
||||
return bah_u;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ch_node_new(): create new, empty node.
|
||||
*/
|
||||
static u3_ch_node*
|
||||
_ch_node_new(void)
|
||||
{
|
||||
u3_ch_node* han_u = u3_ca_walloc(c3_wiseof(u3_ch_node));
|
||||
|
||||
han_u->map_w = 0;
|
||||
return han_u;
|
||||
}
|
||||
|
||||
/* _ch_node_add(): add to node.
|
||||
*/
|
||||
static u3_ch_node*
|
||||
_ch_node_add(u3_ch_node* han_u, c3_w lef_w, c3_w rem_w, u3_noun kev)
|
||||
{
|
||||
c3_w bit_w, inx_w, map_w, i_w;
|
||||
|
||||
lef_w -= 5;
|
||||
bit_w = (rem_w >> lef_w);
|
||||
rem_w = (rem_w & ((1 << lef_w) - 1));
|
||||
map_w = han_u->map_w;
|
||||
inx_w = _ch_popcount(map_w & ((1 << bit_w) - 1));
|
||||
|
||||
if ( map_w & (1 << bit_w) ) {
|
||||
c3_w sot_w = han_u->sot_w[inx_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_node(sot_w)) ) {
|
||||
void* hav_v = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
hav_v = _ch_some_add(hav_v, lef_w, rem_w, kev);
|
||||
han_u->sot_w[inx_w] = u3_ch_node_to_slot(hav_v);
|
||||
|
||||
return han_u;
|
||||
}
|
||||
else {
|
||||
u3_noun kov = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
if ( u3_yes == u3_cr_sing(u3h(kev), u3h(kov)) ) {
|
||||
u3_ca_lose(kov);
|
||||
han_u->sot_w[inx_w] = u3_ch_noun_to_slot(kev);
|
||||
return han_u;
|
||||
}
|
||||
else {
|
||||
c3_w rom_w = u3_cr_mug(u3h(kov)) & ((1 << lef_w) - 1);
|
||||
void* hav_v = _ch_some_new(lef_w);
|
||||
|
||||
// Optimize: need a custom collision create.
|
||||
//
|
||||
hav_v = _ch_some_add(hav_v, lef_w, rem_w, kev);
|
||||
hav_v = _ch_some_add(hav_v, lef_w, rom_w, kov);
|
||||
|
||||
han_u->sot_w[inx_w] = u3_ch_node_to_slot(hav_v);
|
||||
return han_u;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
// Optimize: use u3_ca_wealloc.
|
||||
//
|
||||
c3_w len_w = _ch_popcount(map_w);
|
||||
u3_ch_node* nah_u = u3_ca_walloc(c3_wiseof(u3_ch_node) +
|
||||
((len_w + 1) * c3_wiseof(u3_ch_slot)));
|
||||
nah_u->map_w = han_u->map_w | (1 << bit_w);
|
||||
|
||||
for ( i_w = 0; i_w < inx_w; i_w++ ) {
|
||||
nah_u->sot_w[i_w] = han_u->sot_w[i_w];
|
||||
}
|
||||
nah_u->sot_w[inx_w] = u3_ch_noun_to_slot(kev);
|
||||
|
||||
for ( i_w = inx_w; i_w < len_w; i_w++ ) {
|
||||
nah_u->sot_w[i_w + 1] = han_u->sot_w[i_w];
|
||||
}
|
||||
u3_ca_free(han_u);
|
||||
return nah_u;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ch_some_new(): create node or bucket.
|
||||
*/
|
||||
static void*
|
||||
_ch_some_new(c3_w lef_w)
|
||||
{
|
||||
if ( 0 == lef_w ) {
|
||||
return _ch_buck_new();
|
||||
}
|
||||
else {
|
||||
return _ch_node_new();
|
||||
}
|
||||
}
|
||||
|
||||
/* _ch_some_add(): add to node or bucket.
|
||||
*/
|
||||
static void*
|
||||
_ch_some_add(void* han_v, c3_w lef_w, c3_w rem_w, u3_noun kev)
|
||||
{
|
||||
if ( 0 == lef_w ) {
|
||||
return _ch_buck_add(han_v, kev);
|
||||
}
|
||||
else return _ch_node_add(han_v, lef_w, rem_w, kev);
|
||||
}
|
||||
|
||||
/* u3_ch_put(): insert in hashtable.
|
||||
**
|
||||
** `key` is RETAINED; `val` is transferred.
|
||||
*/
|
||||
void
|
||||
u3_ch_put(u3p(u3_ch_root) har_p, u3_noun key, u3_noun val)
|
||||
{
|
||||
u3_ch_root* har_u = u3to(u3_ch_root, har_p);
|
||||
u3_noun kev = u3nc(u3k(key), val);
|
||||
c3_w mug_w = u3_cr_mug(key);
|
||||
c3_w inx_w = (mug_w >> 25);
|
||||
c3_w rem_w = (mug_w & ((1 << 25) - 1));
|
||||
c3_w sot_w = har_u->sot_w[inx_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_null(sot_w)) ) {
|
||||
har_u->sot_w[inx_w] = u3_ch_noun_to_slot(kev);
|
||||
}
|
||||
else {
|
||||
u3_ch_node* han_u;
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kov = u3_ch_slot_to_noun(sot_w);
|
||||
c3_w rom_w = u3_cr_mug(u3h(kov)) & ((1 << 25) - 1);
|
||||
|
||||
han_u = _ch_node_new();
|
||||
han_u = _ch_node_add(han_u, 25, rem_w, kev);
|
||||
han_u = _ch_node_add(han_u, 25, rom_w, kov);
|
||||
}
|
||||
else {
|
||||
han_u = _ch_node_add(u3_ch_slot_to_node(sot_w), 25, rem_w, kev);
|
||||
}
|
||||
har_u->sot_w[inx_w] = u3_ch_node_to_slot(han_u);
|
||||
}
|
||||
}
|
||||
|
||||
/* _ch_buck_hum(): read in bucket.
|
||||
*/
|
||||
static c3_o
|
||||
_ch_buck_hum(u3_ch_buck* hab_u, c3_w mug_w)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < hab_u->len_w; i_w++ ) {
|
||||
if ( mug_w == u3_cr_mug(u3h(hab_u->kev[i_w])) ) {
|
||||
return u3_yes;
|
||||
}
|
||||
}
|
||||
return u3_no;
|
||||
}
|
||||
|
||||
/* _ch_node_hum(): read in node.
|
||||
*/
|
||||
static c3_o
|
||||
_ch_node_hum(u3_ch_node* han_u, c3_w lef_w, c3_w rem_w, c3_w mug_w)
|
||||
{
|
||||
c3_w bit_w, map_w;
|
||||
|
||||
lef_w -= 5;
|
||||
bit_w = (rem_w >> lef_w);
|
||||
rem_w = (rem_w & ((1 << lef_w) - 1));
|
||||
map_w = han_u->map_w;
|
||||
|
||||
if ( !(map_w & (1 << bit_w)) ) {
|
||||
return u3_no;
|
||||
}
|
||||
else {
|
||||
c3_w inx_w = _ch_popcount(map_w & ((1 << bit_w) - 1));
|
||||
c3_w sot_w = han_u->sot_w[inx_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
if ( mug_w == u3_cr_mug(u3h(kev)) ) {
|
||||
return u3_yes;
|
||||
}
|
||||
else {
|
||||
return u3_no;
|
||||
}
|
||||
}
|
||||
else {
|
||||
void* hav_v = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
if ( 0 == lef_w ) {
|
||||
return _ch_buck_hum(hav_v, mug_w);
|
||||
}
|
||||
else return _ch_node_hum(hav_v, lef_w, rem_w, mug_w);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ch_hum(): read from hashtable.
|
||||
**
|
||||
** `key` is RETAINED.
|
||||
*/
|
||||
c3_o
|
||||
u3_ch_hum(u3p(u3_ch_root) har_p, c3_w mug_w)
|
||||
{
|
||||
u3_ch_root* har_u = u3to(u3_ch_root, har_p);
|
||||
c3_w inx_w = (mug_w >> 25);
|
||||
c3_w rem_w = (mug_w & ((1 << 25) - 1));
|
||||
c3_w sot_w = har_u->sot_w[inx_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_null(sot_w)) ) {
|
||||
return u3_no;
|
||||
}
|
||||
else if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
if ( mug_w == u3_cr_mug(u3h(kev)) ) {
|
||||
return u3_yes;
|
||||
}
|
||||
else {
|
||||
return u3_no;
|
||||
}
|
||||
}
|
||||
else {
|
||||
u3_ch_node* han_u = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
return _ch_node_hum(han_u, 25, rem_w, mug_w);
|
||||
}
|
||||
}
|
||||
|
||||
/* _ch_buck_get(): read in bucket.
|
||||
*/
|
||||
static u3_weak
|
||||
_ch_buck_get(u3_ch_buck* hab_u, u3_noun key)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < hab_u->len_w; i_w++ ) {
|
||||
if ( u3_so(u3_cr_sing(key, u3h(hab_u->kev[i_w]))) ) {
|
||||
return u3_ca_gain(u3t(hab_u->kev[i_w]));
|
||||
}
|
||||
}
|
||||
return u3_none;
|
||||
}
|
||||
|
||||
/* _ch_node_get(): read in node.
|
||||
*/
|
||||
static u3_weak
|
||||
_ch_node_get(u3_ch_node* han_u, c3_w lef_w, c3_w rem_w, u3_noun key)
|
||||
{
|
||||
c3_w bit_w, map_w;
|
||||
|
||||
lef_w -= 5;
|
||||
bit_w = (rem_w >> lef_w);
|
||||
rem_w = (rem_w & ((1 << lef_w) - 1));
|
||||
map_w = han_u->map_w;
|
||||
|
||||
if ( !(map_w & (1 << bit_w)) ) {
|
||||
return u3_none;
|
||||
}
|
||||
else {
|
||||
c3_w inx_w = _ch_popcount(map_w & ((1 << bit_w) - 1));
|
||||
c3_w sot_w = han_u->sot_w[inx_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
if ( u3_so(u3_cr_sing(key, u3h(kev))) ) {
|
||||
return u3_ca_gain(u3t(kev));
|
||||
}
|
||||
else {
|
||||
return u3_none;
|
||||
}
|
||||
}
|
||||
else {
|
||||
void* hav_v = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
if ( 0 == lef_w ) {
|
||||
return _ch_buck_get(hav_v, key);
|
||||
}
|
||||
else return _ch_node_get(hav_v, lef_w, rem_w, key);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ch_get(): read from hashtable.
|
||||
**
|
||||
** `key` is RETAINED.
|
||||
*/
|
||||
u3_weak
|
||||
u3_ch_get(u3p(u3_ch_root) har_p, u3_noun key)
|
||||
{
|
||||
u3_ch_root* har_u = u3to(u3_ch_root, har_p);
|
||||
c3_w mug_w = u3_cr_mug(key);
|
||||
c3_w inx_w = (mug_w >> 25);
|
||||
c3_w rem_w = (mug_w & ((1 << 25) - 1));
|
||||
c3_w sot_w = har_u->sot_w[inx_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_null(sot_w)) ) {
|
||||
return u3_none;
|
||||
}
|
||||
else if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
if ( u3_so(u3_cr_sing(key, u3h(kev))) ) {
|
||||
har_u->sot_w[inx_w] = u3_ch_noun_be_warm(sot_w);
|
||||
return u3_ca_gain(u3t(kev));
|
||||
}
|
||||
else {
|
||||
return u3_none;
|
||||
}
|
||||
}
|
||||
else {
|
||||
u3_ch_node* han_u = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
return _ch_node_get(han_u, 25, rem_w, key);
|
||||
}
|
||||
}
|
||||
|
||||
/* _ch_buck_gut(): read in bucket, unifying key nouns.
|
||||
*/
|
||||
static u3_weak
|
||||
_ch_buck_gut(u3_ch_buck* hab_u, u3_noun key)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < hab_u->len_w; i_w++ ) {
|
||||
if ( u3_so(u3_cr_sung(key, u3h(hab_u->kev[i_w]))) ) {
|
||||
return u3_ca_gain(u3t(hab_u->kev[i_w]));
|
||||
}
|
||||
}
|
||||
return u3_none;
|
||||
}
|
||||
|
||||
/* _ch_node_gut(): read in node, unifying key nouns.
|
||||
*/
|
||||
static u3_weak
|
||||
_ch_node_gut(u3_ch_node* han_u, c3_w lef_w, c3_w rem_w, u3_noun key)
|
||||
{
|
||||
c3_w bit_w, map_w;
|
||||
|
||||
lef_w -= 5;
|
||||
bit_w = (rem_w >> lef_w);
|
||||
rem_w = (rem_w & ((1 << lef_w) - 1));
|
||||
map_w = han_u->map_w;
|
||||
|
||||
if ( !(map_w & (1 << bit_w)) ) {
|
||||
return u3_none;
|
||||
}
|
||||
else {
|
||||
c3_w inx_w = _ch_popcount(map_w & ((1 << bit_w) - 1));
|
||||
c3_w sot_w = han_u->sot_w[inx_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
if ( u3_so(u3_cr_sung(key, u3h(kev))) ) {
|
||||
return u3_ca_gain(u3t(kev));
|
||||
}
|
||||
else {
|
||||
return u3_none;
|
||||
}
|
||||
}
|
||||
else {
|
||||
void* hav_v = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
if ( 0 == lef_w ) {
|
||||
return _ch_buck_gut(hav_v, key);
|
||||
}
|
||||
else return _ch_node_gut(hav_v, lef_w, rem_w, key);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ch_gut(): read from hashtable, unifying key nouns.
|
||||
**
|
||||
** `key` is RETAINED.
|
||||
*/
|
||||
u3_weak
|
||||
u3_ch_gut(u3p(u3_ch_root) har_p, u3_noun key)
|
||||
{
|
||||
u3_ch_root* har_u = u3to(u3_ch_root, har_p);
|
||||
c3_w mug_w = u3_cr_mug(key);
|
||||
c3_w inx_w = (mug_w >> 25);
|
||||
c3_w rem_w = (mug_w & ((1 << 25) - 1));
|
||||
c3_w sot_w = har_u->sot_w[inx_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_null(sot_w)) ) {
|
||||
return u3_none;
|
||||
}
|
||||
else if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
if ( u3_so(u3_cr_sung(key, u3h(kev))) ) {
|
||||
har_u->sot_w[inx_w] = u3_ch_noun_be_warm(sot_w);
|
||||
return u3_ca_gain(u3t(kev));
|
||||
}
|
||||
else {
|
||||
return u3_none;
|
||||
}
|
||||
}
|
||||
else {
|
||||
u3_ch_node* han_u = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
return _ch_node_gut(han_u, 25, rem_w, key);
|
||||
}
|
||||
}
|
||||
|
||||
/* _ch_free_buck(): free bucket
|
||||
*/
|
||||
static void
|
||||
_ch_free_buck(u3_ch_buck* hab_u)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < hab_u->len_w; i_w++ ) {
|
||||
u3_ca_lose(hab_u->kev[i_w]);
|
||||
}
|
||||
u3_ca_free(hab_u);
|
||||
}
|
||||
|
||||
/* _ch_free_node(): free node.
|
||||
*/
|
||||
static void
|
||||
_ch_free_node(u3_ch_node* han_u, c3_w lef_w)
|
||||
{
|
||||
c3_w len_w = _ch_popcount(han_u->map_w);
|
||||
c3_w i_w;
|
||||
|
||||
lef_w -= 5;
|
||||
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
c3_w sot_w = han_u->sot_w[i_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
u3_ca_lose(kev);
|
||||
}
|
||||
else {
|
||||
void* hav_v = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
if ( 0 == lef_w ) {
|
||||
_ch_free_buck(hav_v);
|
||||
} else {
|
||||
_ch_free_node(hav_v, lef_w);
|
||||
}
|
||||
}
|
||||
}
|
||||
u3_ca_free(han_u);
|
||||
}
|
||||
|
||||
/* u3_ch_free(): free hashtable.
|
||||
*/
|
||||
void
|
||||
u3_ch_free(u3p(u3_ch_root) har_p)
|
||||
{
|
||||
u3_ch_root* har_u = u3to(u3_ch_root, har_p);
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 64; i_w++ ) {
|
||||
c3_w sot_w = har_u->sot_w[i_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
u3_ca_lose(kev);
|
||||
}
|
||||
else if ( u3_so(u3_ch_slot_is_node(sot_w)) ) {
|
||||
u3_ch_node* han_u = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
_ch_free_node(han_u, 25);
|
||||
}
|
||||
}
|
||||
u3_ca_free(har_u);
|
||||
}
|
||||
|
||||
/* _ch_walk_buck(): walk bucket for gc.
|
||||
*/
|
||||
static void
|
||||
_ch_walk_buck(u3_ch_buck* hab_u, void (*fun_f)(u3_noun))
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < hab_u->len_w; i_w++ ) {
|
||||
fun_f(hab_u->kev[i_w]);
|
||||
}
|
||||
}
|
||||
|
||||
/* _ch_walk_node(): walk node for gc.
|
||||
*/
|
||||
static void
|
||||
_ch_walk_node(u3_ch_node* han_u, c3_w lef_w, void (*fun_f)(u3_noun))
|
||||
{
|
||||
c3_w len_w = _ch_popcount(han_u->map_w);
|
||||
c3_w i_w;
|
||||
|
||||
lef_w -= 5;
|
||||
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
c3_w sot_w = han_u->sot_w[i_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
fun_f(kev);
|
||||
}
|
||||
else {
|
||||
void* hav_v = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
if ( 0 == lef_w ) {
|
||||
_ch_walk_buck(hav_v, fun_f);
|
||||
} else {
|
||||
_ch_walk_node(hav_v, lef_w, fun_f);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ch_walk(): walk hashtable for gc.
|
||||
*/
|
||||
void
|
||||
u3_ch_walk(u3p(u3_ch_root) har_p, void (*fun_f)(u3_noun))
|
||||
{
|
||||
u3_ch_root* har_u = u3to(u3_ch_root, har_p);
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 64; i_w++ ) {
|
||||
c3_w sot_w = har_u->sot_w[i_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
fun_f(kev);
|
||||
}
|
||||
else if ( u3_so(u3_ch_slot_is_node(sot_w)) ) {
|
||||
u3_ch_node* han_u = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
_ch_walk_node(han_u, 25, fun_f);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* _ch_mark_buck(): mark bucket for gc.
|
||||
*/
|
||||
static void
|
||||
_ch_mark_buck(u3_ch_buck* hab_u)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < hab_u->len_w; i_w++ ) {
|
||||
u3_ca_mark_noun(hab_u->kev[i_w]);
|
||||
}
|
||||
u3_ca_mark_ptr(hab_u);
|
||||
}
|
||||
|
||||
/* _ch_mark_node(): mark node for gc.
|
||||
*/
|
||||
static void
|
||||
_ch_mark_node(u3_ch_node* han_u, c3_w lef_w)
|
||||
{
|
||||
c3_w len_w = _ch_popcount(han_u->map_w);
|
||||
c3_w i_w;
|
||||
|
||||
lef_w -= 5;
|
||||
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
c3_w sot_w = han_u->sot_w[i_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
u3_ca_mark_noun(kev);
|
||||
}
|
||||
else {
|
||||
void* hav_v = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
if ( 0 == lef_w ) {
|
||||
_ch_mark_buck(hav_v);
|
||||
} else {
|
||||
_ch_mark_node(hav_v, lef_w);
|
||||
}
|
||||
}
|
||||
}
|
||||
u3_ca_mark_ptr(han_u);
|
||||
}
|
||||
|
||||
/* u3_ch_mark(): mark hashtable for gc.
|
||||
*/
|
||||
void
|
||||
u3_ch_mark(u3p(u3_ch_root) har_p)
|
||||
{
|
||||
u3_ch_root* har_u = u3to(u3_ch_root, har_p);
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < 64; i_w++ ) {
|
||||
c3_w sot_w = har_u->sot_w[i_w];
|
||||
|
||||
if ( u3_so(u3_ch_slot_is_noun(sot_w)) ) {
|
||||
u3_noun kev = u3_ch_slot_to_noun(sot_w);
|
||||
|
||||
u3_ca_mark_noun(kev);
|
||||
}
|
||||
else if ( u3_so(u3_ch_slot_is_node(sot_w)) ) {
|
||||
u3_ch_node* han_u = u3_ch_slot_to_node(sot_w);
|
||||
|
||||
_ch_mark_node(han_u, 25);
|
||||
}
|
||||
}
|
||||
u3_ca_mark_ptr(har_u);
|
||||
}
|
||||
402
g/i.c
Normal file
402
g/i.c
Normal file
@ -0,0 +1,402 @@
|
||||
/* g/i.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* u3_ci_words():
|
||||
**
|
||||
** Copy [a] words from [b] into an atom.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_words(c3_w a_w,
|
||||
const c3_w* b_w)
|
||||
{
|
||||
/* Strip trailing zeroes.
|
||||
*/
|
||||
while ( a_w && !b_w[a_w - 1] ) {
|
||||
a_w--;
|
||||
}
|
||||
|
||||
/* Check for cat.
|
||||
*/
|
||||
if ( !a_w ) {
|
||||
return 0;
|
||||
}
|
||||
else if ( (a_w == 1) && !(b_w[0] >> 31) ) {
|
||||
return b_w[0];
|
||||
}
|
||||
|
||||
/* Allocate, fill, return.
|
||||
*/
|
||||
{
|
||||
c3_w* nov_w = u3_ca_walloc(a_w + c3_wiseof(u3_cs_atom));
|
||||
u3_cs_atom* nov_u = (void*)nov_w;
|
||||
|
||||
nov_u->mug_w = 0;
|
||||
nov_u->len_w = a_w;
|
||||
|
||||
/* Fill the words.
|
||||
*/
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w=0; i_w < a_w; i_w++ ) {
|
||||
nov_u->buf_w[i_w] = b_w[i_w];
|
||||
}
|
||||
}
|
||||
return u3_co_to_pug(u3_co_outa(nov_w));
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ci_chubs():
|
||||
**
|
||||
** Construct `a` double-words from `b`, LSD first, as an atom.
|
||||
*/
|
||||
u3_atom
|
||||
u3_ci_chubs(c3_w a_w,
|
||||
const c3_d* b_d)
|
||||
{
|
||||
c3_w *b_w = c3_malloc(a_w * 8);
|
||||
c3_w i_w;
|
||||
u3_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 = u3_ci_words((a_w * 2), b_w);
|
||||
free(b_w);
|
||||
return p;
|
||||
}
|
||||
|
||||
/* u3_ci_bytes():
|
||||
**
|
||||
** Copy `a` bytes from `b` to an LSB first atom.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_bytes(c3_w a_w,
|
||||
const c3_y* b_y)
|
||||
{
|
||||
/* Strip trailing zeroes.
|
||||
*/
|
||||
while ( a_w && !b_y[a_w - 1] ) {
|
||||
a_w--;
|
||||
}
|
||||
|
||||
/* Check for cat.
|
||||
*/
|
||||
if ( a_w <= 4 ) {
|
||||
if ( !a_w ) {
|
||||
return 0;
|
||||
}
|
||||
else if ( a_w == 1 ) {
|
||||
return b_y[0];
|
||||
}
|
||||
else if ( a_w == 2 ) {
|
||||
return (b_y[0] | (b_y[1] << 8));
|
||||
}
|
||||
else if ( a_w == 3 ) {
|
||||
return (b_y[0] | (b_y[1] << 8) | (b_y[2] << 16));
|
||||
}
|
||||
else if ( (b_y[3] <= 0x7f) ) {
|
||||
return (b_y[0] | (b_y[1] << 8) | (b_y[2] << 16) | (b_y[3] << 24));
|
||||
}
|
||||
}
|
||||
|
||||
/* Allocate, fill, return.
|
||||
*/
|
||||
{
|
||||
c3_w len_w = (a_w + 3) >> 2;
|
||||
c3_w* nov_w = u3_ca_walloc((len_w + c3_wiseof(u3_cs_atom)));
|
||||
u3_cs_atom* nov_u = (void*)nov_w;
|
||||
|
||||
nov_u->mug_w = 0;
|
||||
nov_u->len_w = len_w;
|
||||
|
||||
/* Clear the words.
|
||||
*/
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w=0; i_w < len_w; i_w++ ) {
|
||||
nov_u->buf_w[i_w] = 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* Fill the bytes.
|
||||
*/
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w=0; i_w < a_w; i_w++ ) {
|
||||
nov_u->buf_w[i_w >> 2] |= (b_y[i_w] << ((i_w & 3) * 8));
|
||||
}
|
||||
}
|
||||
return u3_co_to_pug(u3_co_outa(nov_w));
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ci_mp():
|
||||
**
|
||||
** Copy the GMP integer `a` into an atom, and clear it.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_mp(mpz_t a_mp)
|
||||
{
|
||||
/* Efficiency: unnecessary copy.
|
||||
*/
|
||||
{
|
||||
c3_w pyg_w = mpz_size(a_mp) * ((sizeof(mp_limb_t)) / 4);
|
||||
c3_w *buz_w = alloca(pyg_w * 4);
|
||||
c3_w i_w;
|
||||
|
||||
for ( i_w = 0; i_w < pyg_w; i_w++ ) {
|
||||
buz_w[i_w] = 0;
|
||||
}
|
||||
mpz_export(buz_w, 0, -1, 4, 0, 0, a_mp);
|
||||
mpz_clear(a_mp);
|
||||
|
||||
return u3_ci_words(pyg_w, buz_w);
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ci_vint():
|
||||
**
|
||||
** Create `a + 1`.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_vint(u3_noun a)
|
||||
{
|
||||
c3_assert(u3_none != a);
|
||||
|
||||
if ( u3_so(u3_co_is_cat(a)) ) {
|
||||
c3_w vin_w = (a + 1);
|
||||
|
||||
if ( a == 0x7fffffff ) {
|
||||
return u3_ci_words(1, &vin_w);
|
||||
}
|
||||
else return vin_w;
|
||||
}
|
||||
else if ( u3_so(u3_co_is_cell(a)) ) {
|
||||
return u3_cm_bail(c3__exit);
|
||||
}
|
||||
else {
|
||||
mpz_t a_mp;
|
||||
|
||||
u3_cr_mp(a_mp, a);
|
||||
u3_ca_lose(a);
|
||||
|
||||
mpz_add_ui(a_mp, a_mp, 1);
|
||||
return u3_ci_mp(a_mp);
|
||||
}
|
||||
}
|
||||
|
||||
extern int FOO;
|
||||
|
||||
u3_noun BAD;
|
||||
|
||||
/* u3_ci_cell():
|
||||
**
|
||||
** Produce the cell `[a b]`.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_cell(u3_noun a, u3_noun b)
|
||||
{
|
||||
c3_assert(u3_none != a);
|
||||
c3_assert(u3_none != b);
|
||||
|
||||
c3_assert(u3_ne(u3_co_is_junior(u3R, a)));
|
||||
c3_assert(u3_ne(u3_co_is_junior(u3R, b)));
|
||||
|
||||
{
|
||||
c3_w* nov_w = u3_ca_walloc(c3_wiseof(u3_cs_cell));
|
||||
u3_cs_cell* nov_u = (void *)nov_w;
|
||||
u3_noun pro;
|
||||
|
||||
nov_u->mug_w = 0;
|
||||
nov_u->hed = a;
|
||||
nov_u->tel = b;
|
||||
|
||||
pro = u3_co_to_pom(u3_co_outa(nov_w));
|
||||
#if 0
|
||||
if ( 0x15d47649 == u3_cr_mug(pro) ) {
|
||||
fprintf(stderr, "BAD %x\r\n", pro);
|
||||
BAD = pro;
|
||||
}
|
||||
#endif
|
||||
#if 1
|
||||
return pro;
|
||||
#else
|
||||
if ( !FOO ) return u3_co_to_pom(u3_co_outa(nov_w));
|
||||
else {
|
||||
u3_noun pro = u3_co_to_pom(u3_co_outa(nov_w));
|
||||
|
||||
u3_cm_p("leaked", pro);
|
||||
printf("pro %u, %x\r\n", pro, u3_cr_mug(pro));
|
||||
abort();
|
||||
}
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ci_trel():
|
||||
**
|
||||
** Produce the triple `[a b c]`.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_trel(u3_noun a, u3_noun b, u3_noun c)
|
||||
{
|
||||
return u3_ci_cell(a, u3_ci_cell(b, c));
|
||||
}
|
||||
|
||||
/* u3_ci_qual():
|
||||
**
|
||||
** Produce the cell `[a b c d]`.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_qual(u3_noun a, u3_noun b, u3_noun c, u3_noun d)
|
||||
{
|
||||
return u3_ci_cell(a, u3_ci_trel(b, c, d));
|
||||
}
|
||||
|
||||
/* u3_ci_string():
|
||||
**
|
||||
** Produce an LSB-first atom from the C string `a`.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_string(const c3_c* a_c)
|
||||
{
|
||||
return u3_ci_bytes(strlen(a_c), (c3_y *)a_c);
|
||||
}
|
||||
|
||||
/* u3_ci_tape(): from a C string, to a list of bytes.
|
||||
*/
|
||||
u3_atom
|
||||
u3_ci_tape(const c3_c* txt_c)
|
||||
{
|
||||
if ( !*txt_c ) {
|
||||
return u3_nul;
|
||||
} else return u3_ci_cell(*txt_c, u3_ci_tape(txt_c + 1));
|
||||
}
|
||||
|
||||
/* u3_ci_decimal():
|
||||
**
|
||||
** Parse `a` as a list of decimal digits.
|
||||
*/
|
||||
u3_atom
|
||||
u3_ci_decimal(u3_noun a);
|
||||
|
||||
/* u3_ci_heximal():
|
||||
**
|
||||
** Parse `a` as a list of hex digits.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_heximal(u3_noun a);
|
||||
|
||||
/* u3_ci_list():
|
||||
**
|
||||
** Generate a null-terminated list, with `u3_none` as terminator.
|
||||
*/
|
||||
u3_noun
|
||||
u3_ci_list(u3_weak one, ...);
|
||||
|
||||
|
||||
/* u3_ci_molt():
|
||||
**
|
||||
** Mutate `som` with a 0-terminated list of axis, noun pairs.
|
||||
** Axes must be cats (31 bit).
|
||||
*/
|
||||
struct _molt_pair {
|
||||
c3_w axe_w;
|
||||
u3_noun som;
|
||||
};
|
||||
|
||||
static c3_w
|
||||
_molt_cut(c3_w len_w,
|
||||
struct _molt_pair* pms_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 = pms_m[i_w].axe_w;
|
||||
|
||||
if ( (cut_t == c3_false) && (3 == u3_ax_cap(axe_w)) ) {
|
||||
cut_t = c3_true;
|
||||
cut_w = i_w;
|
||||
}
|
||||
pms_m[i_w].axe_w = u3_ax_mas(axe_w);
|
||||
}
|
||||
return cut_t ? cut_w : i_w;
|
||||
}
|
||||
|
||||
static u3_noun // transfer
|
||||
_molt_apply(u3_noun som, // retain
|
||||
c3_w len_w,
|
||||
struct _molt_pair* pms_m) // transfer
|
||||
{
|
||||
if ( len_w == 0 ) {
|
||||
return u3_ca_gain(som);
|
||||
}
|
||||
else if ( (len_w == 1) && (1 == pms_m[0].axe_w) ) {
|
||||
return pms_m[0].som;
|
||||
}
|
||||
else {
|
||||
c3_w cut_w = _molt_cut(len_w, pms_m);
|
||||
|
||||
if ( u3_no == u3_co_is_cell(som) ) {
|
||||
return u3_cm_bail(c3__exit);
|
||||
}
|
||||
else {
|
||||
return u3_ci_cell
|
||||
(_molt_apply(u3_co_h(som), cut_w, pms_m),
|
||||
_molt_apply(u3_co_t(som), (len_w - cut_w), (pms_m + cut_w)));
|
||||
}
|
||||
}
|
||||
}
|
||||
u3_noun
|
||||
u3_ci_molt(u3_noun som, ...)
|
||||
{
|
||||
va_list ap;
|
||||
c3_w len_w;
|
||||
struct _molt_pair* pms_m;
|
||||
u3_noun pro;
|
||||
|
||||
/* Count.
|
||||
*/
|
||||
len_w = 0;
|
||||
{
|
||||
va_start(ap, som);
|
||||
while ( 1 ) {
|
||||
if ( 0 == va_arg(ap, c3_w) ) {
|
||||
break;
|
||||
}
|
||||
va_arg(ap, u3_weak*);
|
||||
len_w++;
|
||||
}
|
||||
va_end(ap);
|
||||
}
|
||||
pms_m = alloca(len_w * sizeof(struct _molt_pair));
|
||||
|
||||
/* Install.
|
||||
*/
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
va_start(ap, som);
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
pms_m[i_w].axe_w = va_arg(ap, c3_w);
|
||||
pms_m[i_w].som = va_arg(ap, u3_noun);
|
||||
}
|
||||
va_end(ap);
|
||||
}
|
||||
|
||||
/* Apply.
|
||||
*/
|
||||
pro = _molt_apply(som, len_w, pms_m);
|
||||
u3_ca_lose(som);
|
||||
return pro;
|
||||
}
|
||||
|
||||
990
g/j.c
Normal file
990
g/j.c
Normal file
@ -0,0 +1,990 @@
|
||||
/* g/j.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* _cj_count(): count and link dashboard entries.
|
||||
*/
|
||||
static c3_w
|
||||
_cj_count(u3_cs_core* par_u, u3_cs_core* dev_u)
|
||||
{
|
||||
c3_w len_l = 0;
|
||||
c3_w i_w;
|
||||
|
||||
if ( dev_u ) {
|
||||
for ( i_w = 0; 0 != dev_u[i_w].cos_c; i_w++ ) {
|
||||
u3_cs_core* kid_u = &dev_u[i_w];
|
||||
|
||||
kid_u->par_u = par_u;
|
||||
len_l += _cj_count(kid_u, kid_u->dev_u);
|
||||
}
|
||||
}
|
||||
return 1 + len_l;
|
||||
}
|
||||
/* _cj_install(): install dashboard entries.
|
||||
*/
|
||||
static c3_w
|
||||
_cj_install(u3_cs_core* ray_u, c3_w jax_l, u3_cs_core* dev_u)
|
||||
{
|
||||
c3_w i_w;
|
||||
|
||||
if ( dev_u ) {
|
||||
for ( i_w = 0; 0 != dev_u[i_w].cos_c; i_w++ ) {
|
||||
u3_cs_core* kid_u = &dev_u[i_w];
|
||||
|
||||
kid_u->jax_l = jax_l;
|
||||
ray_u[jax_l++] = *kid_u;
|
||||
|
||||
jax_l = _cj_install(ray_u, jax_l, kid_u->dev_u);
|
||||
}
|
||||
}
|
||||
return jax_l;
|
||||
}
|
||||
|
||||
/* _cj_axis(): axis from formula, or 0. `fol` is RETAINED.
|
||||
*/
|
||||
static c3_l
|
||||
_cj_axis(u3_noun fol)
|
||||
{
|
||||
u3_noun p_fol, q_fol, r_fol;
|
||||
|
||||
while ( u3_so(u3du(fol)) && (10 == u3h(fol)) )
|
||||
{ fol = u3t(u3t(fol)); }
|
||||
|
||||
if ( u3_ne(u3_cr_trel(fol, &p_fol, &q_fol, &r_fol)) ) {
|
||||
if ( u3_ne(u3_cr_cell(fol, &p_fol, &q_fol)) ||
|
||||
(0 != p_fol) ||
|
||||
(u3_ne(u3_co_is_cat(q_fol))) )
|
||||
{
|
||||
fprintf(stderr, "axis: bad a\r\n");
|
||||
return 0;
|
||||
}
|
||||
return q_fol;
|
||||
}
|
||||
else {
|
||||
if ( 9 != p_fol )
|
||||
{ fprintf(stderr, "axis: bad b\r\n"); return 0; }
|
||||
if ( u3_ne(u3_co_is_cat(q_fol)) )
|
||||
{ fprintf(stderr, "axis: bad c\r\n"); return 0; }
|
||||
if ( u3_ne(u3du(r_fol)) || (0 != u3h(r_fol)) || (1 != u3t(r_fol)) )
|
||||
{ fprintf(stderr, "axis: bad d\r\n"); return 0; }
|
||||
|
||||
return q_fol;
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_by_gut(): (~(get by a) b), unifying; RETAINS a, b, AND result.
|
||||
*/
|
||||
static u3_weak
|
||||
_cj_by_gut(u3_noun a, u3_noun b)
|
||||
{
|
||||
if ( u3_nul == a ) {
|
||||
return u3_none;
|
||||
}
|
||||
else {
|
||||
u3_noun l_a, n_a, r_a;
|
||||
u3_noun pn_a, qn_a;
|
||||
|
||||
u3_cx_trel(a, &n_a, &l_a, &r_a);
|
||||
u3_cx_cell(n_a, &pn_a, &qn_a);
|
||||
{
|
||||
if ( (u3_yes == u3_cr_sing(b, pn_a)) ) {
|
||||
return qn_a;
|
||||
}
|
||||
else {
|
||||
if ( u3_yes == u3_cqc_gor(b, pn_a) ) {
|
||||
return _cj_by_gut(l_a, b);
|
||||
}
|
||||
else return _cj_by_gut(r_a, b);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_chum(): decode chum as string.
|
||||
*/
|
||||
static c3_c*
|
||||
_cj_chum(u3_noun chu)
|
||||
{
|
||||
if ( u3_so(u3ud(chu)) ) {
|
||||
return u3_cr_string(chu);
|
||||
}
|
||||
else {
|
||||
u3_noun h_chu = u3h(chu);
|
||||
u3_noun t_chu = u3t(chu);
|
||||
|
||||
if ( u3_ne(u3_co_is_cat(t_chu)) ) {
|
||||
return 0;
|
||||
} else {
|
||||
c3_c* h_chu_c = u3_cr_string(h_chu);
|
||||
c3_c buf[33];
|
||||
|
||||
memset(buf, 0, 33);
|
||||
snprintf(buf, 32, "%s%d", h_chu_c, t_chu);
|
||||
|
||||
free(h_chu_c);
|
||||
return strdup(buf);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_je_fsck: fsck:je, or none.
|
||||
*/
|
||||
static u3_noun
|
||||
_cj_je_fsck(u3_noun clu)
|
||||
{
|
||||
u3_noun p_clu, q_clu, r_clu;
|
||||
u3_noun huk;
|
||||
c3_c* nam_c;
|
||||
c3_l axe_l;
|
||||
|
||||
if ( u3_no == u3_cr_trel(clu, &p_clu, &q_clu, &r_clu) ) {
|
||||
u3z(clu); return u3_none;
|
||||
}
|
||||
if ( 0 == (nam_c = _cj_chum(p_clu)) ) {
|
||||
u3z(clu); return u3_none;
|
||||
}
|
||||
while ( u3_so(u3du(q_clu)) && (10 == u3h(q_clu)) ) {
|
||||
q_clu = u3t(u3t(q_clu));
|
||||
}
|
||||
if ( u3_ne(u3du(q_clu)) ) {
|
||||
u3z(clu); free(nam_c); return u3_none;
|
||||
}
|
||||
|
||||
if ( (1 == u3h(q_clu)) && (0 == u3t(q_clu)) ) {
|
||||
axe_l = 0;
|
||||
}
|
||||
else {
|
||||
if ( (0 != u3h(q_clu)) || u3_ne(u3_co_is_cat(axe_l = u3t(q_clu))) ) {
|
||||
u3z(clu); free(nam_c); return u3_none;
|
||||
}
|
||||
}
|
||||
|
||||
{
|
||||
huk = 0;
|
||||
|
||||
while ( u3_so(u3du(r_clu)) ) {
|
||||
u3_noun ir_clu, tr_clu, pir_clu, qir_clu;
|
||||
|
||||
if ( (u3_no == u3_cr_cell(r_clu, &ir_clu, &tr_clu)) ||
|
||||
(u3_no == u3_cr_cell(ir_clu, &pir_clu, &qir_clu)) ||
|
||||
(u3_no == u3ud(pir_clu)) )
|
||||
{
|
||||
u3z(huk); u3z(clu); free(nam_c); return u3_none;
|
||||
}
|
||||
huk = u3_ckdb_put(huk, u3k(pir_clu), u3k(qir_clu));
|
||||
r_clu = tr_clu;
|
||||
}
|
||||
}
|
||||
u3z(clu);
|
||||
return u3nt(u3_ci_string(nam_c), axe_l, huk);
|
||||
}
|
||||
|
||||
/* _cj_sham(): ++sham.
|
||||
*/
|
||||
static u3_atom
|
||||
_cj_sham(u3_noun som) // XX wrong, does not match ++sham
|
||||
{
|
||||
u3_atom jam = u3_cke_jam(som);
|
||||
u3_noun sha = u3_cqe_shax(jam);
|
||||
u3_noun haf = u3_cqc_end(7, 1, sha);
|
||||
|
||||
u3z(jam); u3z(sha);
|
||||
return haf;
|
||||
}
|
||||
|
||||
/* _cj_cold_find_sys: search `sys` in dashboard. RETAINS `bat` AND result.
|
||||
*/
|
||||
static u3_weak
|
||||
_cj_cold_find_sys(u3_noun bat)
|
||||
{
|
||||
u3_cs_road* rod_u = u3R;
|
||||
|
||||
while ( 1 ) {
|
||||
u3_noun pro = _cj_by_gut(u3h(rod_u->jed.das), bat);
|
||||
|
||||
if ( pro != u3_none ) {
|
||||
return pro;
|
||||
}
|
||||
|
||||
if ( !rod_u->par_u ) break;
|
||||
rod_u = rod_u->par_u;
|
||||
}
|
||||
return u3_none;
|
||||
}
|
||||
|
||||
/* _cj_cold_mine(): in cold mode, declare a core. RETAINS.
|
||||
*/
|
||||
static u3_weak
|
||||
_cj_cold_mine(u3_noun cey, u3_noun cor)
|
||||
{
|
||||
u3_noun bat = u3h(cor);
|
||||
u3_noun p_cey, q_cey, r_cey;
|
||||
|
||||
u3_cr_trel(cey, &p_cey, &q_cey, &r_cey);
|
||||
{
|
||||
/* Calculate semantic identity (mop).
|
||||
*/
|
||||
u3_noun mop;
|
||||
|
||||
if ( 0 == q_cey ) {
|
||||
mop = u3nq(u3k(p_cey), 3, u3_no, u3k(bat));
|
||||
}
|
||||
else {
|
||||
u3_weak rah = u3_cr_at(q_cey, cor);
|
||||
|
||||
if ( (u3_none == rah) || u3_ne(u3du(rah)) ) {
|
||||
fprintf(stderr, "fund: %s is bogus\r\n", u3_cr_string(p_cey));
|
||||
return u3_none;
|
||||
}
|
||||
else {
|
||||
u3_noun soh = _cj_cold_find_sys(u3h(rah));
|
||||
|
||||
if ( u3_none == soh ) {
|
||||
fprintf(stderr, "fund: in %s, parent %x not found at %d\r\n",
|
||||
u3_cr_string(p_cey),
|
||||
u3_cr_mug(u3h(rah)),
|
||||
q_cey);
|
||||
return u3_none;
|
||||
}
|
||||
else {
|
||||
mop = u3nq(u3k(p_cey), u3k(q_cey), u3_yes, u3k(soh));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// Assemble new core pattern.
|
||||
//
|
||||
{
|
||||
u3_noun soh = _cj_sham(u3k(mop));
|
||||
u3_noun hoe = u3_ckdb_get(u3k(u3t(u3R->jed.das)), u3k(soh));
|
||||
u3_noun sab;
|
||||
|
||||
if ( u3_none == hoe ) {
|
||||
sab = u3nt(u3nc(u3k(bat), u3k(r_cey)), u3_nul, u3_nul);
|
||||
}
|
||||
else {
|
||||
sab = u3_ckdb_put(u3k(u3t(hoe)), u3k(bat), u3k(r_cey));
|
||||
u3z(hoe);
|
||||
}
|
||||
{
|
||||
u3_noun sad, h_sad, t_sad;
|
||||
|
||||
h_sad = u3_ckdb_put(u3k(u3h(u3R->jed.das)), u3k(bat), u3k(soh));
|
||||
t_sad = u3_ckdb_put(u3k(u3t(u3R->jed.das)), soh,
|
||||
u3nc(u3k(mop), sab));
|
||||
sad = u3nc(h_sad, t_sad);
|
||||
|
||||
u3z(u3R->jed.das);
|
||||
u3R->jed.das = sad;
|
||||
}
|
||||
|
||||
|
||||
return mop;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_warm_fend(): in warm state, return u3_none or calx. RETAINS.
|
||||
*/
|
||||
u3_weak
|
||||
_cj_warm_fend(u3_noun bat)
|
||||
{
|
||||
u3_cs_road* rod_u = u3R;
|
||||
|
||||
while ( 1 ) {
|
||||
u3_weak jaw = u3_ch_gut(rod_u->jed.har_p, bat);
|
||||
|
||||
if ( u3_none != jaw ) {
|
||||
return jaw;
|
||||
}
|
||||
|
||||
if ( rod_u->par_u ) {
|
||||
rod_u = rod_u->par_u;
|
||||
}
|
||||
else return u3_none;
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_warm_hump(): generate axis-to-arm map. RETAIN.
|
||||
*/
|
||||
static u3_noun
|
||||
_cj_warm_hump(c3_l jax_l, u3_noun huc)
|
||||
{
|
||||
u3_noun hap = u3_nul;
|
||||
u3_cs_core* cop_u;
|
||||
|
||||
/* Compute axes of all correctly declared arms.
|
||||
*/
|
||||
if ( jax_l && (cop_u = &u3D.ray_u[jax_l])->arm_u ) {
|
||||
u3_cs_harm* jet_u;
|
||||
c3_l i_l;
|
||||
|
||||
for ( i_l = 0; (jet_u = &cop_u->arm_u[i_l])->fcs_c; i_l++ ) {
|
||||
c3_l axe_l = 0;
|
||||
|
||||
if ( '.' == *(jet_u->fcs_c) ) {
|
||||
c3_d axe_d = 0;
|
||||
|
||||
if ( (1 != sscanf(jet_u->fcs_c+1, "%llu", &axe_d)) ||
|
||||
axe_d >> 32ULL ||
|
||||
((1 << 31) & (axe_l = (c3_w)axe_d)) ||
|
||||
(axe_l < 2) )
|
||||
{
|
||||
fprintf(stderr, "jets: activate: bad fcs %s\r\n", jet_u->fcs_c);
|
||||
}
|
||||
}
|
||||
else {
|
||||
u3_noun nam = u3_ci_string(jet_u->fcs_c);
|
||||
u3_noun fol = u3_ckdb_get(u3k(huc), nam);
|
||||
|
||||
if ( u3_none == fol ) {
|
||||
fprintf(stderr, "jets: activate: bad fcs %s\r\n", jet_u->fcs_c);
|
||||
}
|
||||
else {
|
||||
axe_l = _cj_axis(fol);
|
||||
u3z(fol);
|
||||
}
|
||||
}
|
||||
if ( 0 != axe_l ) {
|
||||
hap = u3_ckdb_put(hap, axe_l, i_l);
|
||||
}
|
||||
}
|
||||
}
|
||||
return hap;
|
||||
}
|
||||
|
||||
/* _cj_boil_mean(): in parent, declare a core. RETAINS.
|
||||
**
|
||||
** XX bat is used only for printing, remove.
|
||||
*/
|
||||
static c3_l
|
||||
_cj_boil_mean(c3_l par_l, u3_noun mop, u3_noun bat)
|
||||
{
|
||||
u3_cs_core* par_u;
|
||||
u3_cs_core* dev_u;
|
||||
|
||||
if ( 0 != par_l ) {
|
||||
par_u = &u3D.ray_u[par_l];
|
||||
dev_u = par_u->dev_u;
|
||||
}
|
||||
else {
|
||||
par_u = 0;
|
||||
dev_u = u3D.dev_u;
|
||||
}
|
||||
|
||||
{
|
||||
c3_w i_l = 0;
|
||||
u3_cs_core* cop_u;
|
||||
|
||||
while ( (cop_u = &dev_u[i_l])->cos_c ) {
|
||||
if ( u3_so(u3_cr_sing_c(cop_u->cos_c, u3h(mop))) ) {
|
||||
#if 0
|
||||
fprintf(stderr, "boil: bound jet %d/%s/%s/%x\r\n",
|
||||
cop_u->jax_l,
|
||||
cop_u->cos_c,
|
||||
par_u ? par_u->cos_c : "~",
|
||||
u3_cr_mug(bat));
|
||||
#endif
|
||||
return cop_u->jax_l;
|
||||
}
|
||||
i_l++;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* _cj_boil_mine(): in boiling state, declare a core. RETAINS.
|
||||
*/
|
||||
static c3_l
|
||||
_cj_boil_mine(u3_noun mop, u3_noun cor)
|
||||
{
|
||||
u3_noun p_mop, q_mop, r_mop, hr_mop, tr_mop;
|
||||
|
||||
u3_cx_trel(mop, &p_mop, &q_mop, &r_mop);
|
||||
u3_cx_cell(r_mop, &hr_mop, &tr_mop);
|
||||
{
|
||||
c3_l par_l;
|
||||
|
||||
// Calculate parent axis.
|
||||
//
|
||||
if ( u3_yes == hr_mop ) {
|
||||
u3_noun cax = _cj_warm_fend(u3h(u3_cr_at(q_mop, cor)));
|
||||
|
||||
par_l = u3h(cax);
|
||||
u3z(cax);
|
||||
}
|
||||
else par_l = 0;
|
||||
|
||||
return _cj_boil_mean(par_l, mop, u3h(cor));
|
||||
}
|
||||
}
|
||||
|
||||
static c3_l _cj_warm_ream_at(u3_noun soh, u3_noun cag);
|
||||
|
||||
/* _cj_warm_ream_be(): install battery; RETAINS.
|
||||
*/
|
||||
static void
|
||||
_cj_warm_ream_be(c3_l jax_l,
|
||||
u3_noun pax,
|
||||
u3_noun bat,
|
||||
u3_noun huc)
|
||||
{
|
||||
u3_ch_put(u3R->jed.har_p,
|
||||
bat,
|
||||
u3nq(jax_l,
|
||||
u3k(pax),
|
||||
_cj_warm_hump(jax_l, huc),
|
||||
u3k(huc)));
|
||||
}
|
||||
|
||||
/* _cj_warm_ream_is(): reream battery; RETAINS.
|
||||
*/
|
||||
static void
|
||||
_cj_warm_ream_is(c3_l jax_l,
|
||||
u3_noun pax,
|
||||
u3_noun sab)
|
||||
{
|
||||
if ( u3_nul != sab ) {
|
||||
u3_noun n_sab, l_sab, r_sab, pn_sab, qn_sab;
|
||||
|
||||
u3_cx_trel(sab, &n_sab, &l_sab, &r_sab);
|
||||
u3_cx_cell(n_sab, &pn_sab, &qn_sab);
|
||||
|
||||
_cj_warm_ream_be(jax_l, pax, pn_sab, qn_sab);
|
||||
_cj_warm_ream_is(jax_l, pax, l_sab);
|
||||
_cj_warm_ream_is(jax_l, pax, r_sab);
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_warm_ream_un(): reream under `soh`; RETAINS.
|
||||
*/
|
||||
static c3_l
|
||||
_cj_warm_ream_un(u3_noun soh)
|
||||
{
|
||||
u3_noun cag = u3_ckdb_got(u3k(u3t(u3R->jed.das)), u3k(soh));
|
||||
u3_noun sab = u3t(cag);
|
||||
u3_noun cax;
|
||||
c3_l jax_l;
|
||||
|
||||
if ( u3_none != (cax = u3_ch_get(u3R->jed.har_p, u3h(u3h(sab)))) ) {
|
||||
jax_l = u3h(cax);
|
||||
u3z(cax);
|
||||
}
|
||||
else {
|
||||
jax_l = _cj_warm_ream_at(soh, cag);
|
||||
}
|
||||
u3z(cag);
|
||||
return jax_l;
|
||||
}
|
||||
|
||||
/* _cj_warm_ream_at(): reream at `soh` and `cag`; RETAINS.
|
||||
*/
|
||||
static c3_l
|
||||
_cj_warm_ream_at(u3_noun soh, u3_noun cag)
|
||||
{
|
||||
u3_noun mop = u3h(cag);
|
||||
u3_noun sab = u3t(cag);
|
||||
u3_noun p_mop, q_mop, r_mop, hr_mop, tr_mop;
|
||||
|
||||
u3_cx_trel(mop, &p_mop, &q_mop, &r_mop);
|
||||
u3_cx_cell(r_mop, &hr_mop, &tr_mop);
|
||||
{
|
||||
c3_l par_l, jax_l;
|
||||
|
||||
if ( u3_yes == hr_mop ) {
|
||||
par_l = _cj_warm_ream_un(tr_mop);
|
||||
}
|
||||
else par_l = 0;
|
||||
|
||||
jax_l = _cj_boil_mean(par_l, mop, 0);
|
||||
|
||||
_cj_warm_ream_is(jax_l, q_mop, sab);
|
||||
return jax_l;
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_warm_ream_in(): reream in `taw`; RETAINS.
|
||||
*/
|
||||
static void
|
||||
_cj_warm_ream_in(u3_noun taw)
|
||||
{
|
||||
if ( u3_nul != taw ) {
|
||||
u3_noun n_taw, l_taw, r_taw, pn_taw, qn_taw;
|
||||
|
||||
u3_cx_trel(taw, &n_taw, &l_taw, &r_taw);
|
||||
u3_cx_cell(n_taw, &pn_taw, &qn_taw);
|
||||
|
||||
_cj_warm_ream_at(pn_taw, qn_taw);
|
||||
_cj_warm_ream_in(l_taw);
|
||||
_cj_warm_ream_in(r_taw);
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_warm_ream(): reream warm from cold state.
|
||||
*/
|
||||
static void
|
||||
_cj_warm_ream(void)
|
||||
{
|
||||
c3_assert(u3R == &(u3H->rod_u));
|
||||
{
|
||||
_cj_warm_ream_in(u3t(u3R->jed.das));
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cj_ream(): reream after restoring from checkpoint.
|
||||
*/
|
||||
void
|
||||
u3_cj_ream(void)
|
||||
{
|
||||
u3_ch_free(u3R->jed.har_p);
|
||||
u3R->jed.har_p = u3_ch_new();
|
||||
|
||||
_cj_warm_ream();
|
||||
}
|
||||
|
||||
/* _cj_warm_mine(): in warm mode, declare a core.
|
||||
*/
|
||||
static void
|
||||
_cj_warm_mine(u3_noun clu, u3_noun cor)
|
||||
{
|
||||
u3_noun bat = u3h(cor);
|
||||
u3_noun cax;
|
||||
|
||||
if ( u3_ne(u3du(cor)) ) {
|
||||
u3z(clu);
|
||||
}
|
||||
else if ( u3_none != (cax = _cj_warm_fend(bat)) ) {
|
||||
u3z(cax); u3z(clu);
|
||||
}
|
||||
else {
|
||||
u3_noun cey = _cj_je_fsck(clu);
|
||||
|
||||
// fprintf(stderr, "warm_mine %s\r\n", u3_cr_string(u3h(cey)));
|
||||
|
||||
if ( u3_none != cey ) {
|
||||
u3_noun huc = u3t(u3t(cey));
|
||||
u3_noun pax = u3h(u3t(cey));
|
||||
u3_noun mop;
|
||||
|
||||
if ( u3_none != (mop = _cj_cold_mine(cey, cor)) ) {
|
||||
c3_l jax_l = _cj_boil_mine(mop, cor);
|
||||
|
||||
// fprintf(stderr, "warm: bat %x\r\n", u3_cr_mug(bat));
|
||||
u3_ch_put(u3R->jed.har_p,
|
||||
bat,
|
||||
u3nq(jax_l,
|
||||
u3k(pax),
|
||||
_cj_warm_hump(jax_l, huc),
|
||||
u3k(huc)));
|
||||
u3z(mop);
|
||||
}
|
||||
u3z(cey);
|
||||
}
|
||||
}
|
||||
u3z(cor);
|
||||
}
|
||||
|
||||
/* u3_cj_boot(): initialize jet system.
|
||||
*/
|
||||
void
|
||||
u3_cj_boot(void)
|
||||
{
|
||||
c3_w jax_l;
|
||||
|
||||
u3D.len_l =_cj_count(0, u3D.dev_u);
|
||||
u3D.all_l = (2 * u3D.len_l) + 1024; // horrid heuristic
|
||||
|
||||
u3D.ray_u = (u3_cs_core*) malloc(u3D.all_l * sizeof(u3_cs_core));
|
||||
memset(u3D.ray_u, 0, (u3D.all_l * sizeof(u3_cs_core)));
|
||||
|
||||
jax_l = _cj_install(u3D.ray_u, 1, u3D.dev_u);
|
||||
fprintf(stderr, "boot: installed %d jets\n", jax_l);
|
||||
}
|
||||
|
||||
/* _cj_find(): search for jet, old school. `bat` is RETAINED.
|
||||
*/
|
||||
c3_l
|
||||
_cj_find(u3_noun bat)
|
||||
{
|
||||
u3_cs_road* rod_u = u3R;
|
||||
|
||||
while ( 1 ) {
|
||||
u3_weak jaw = u3_ch_gut(rod_u->jed.har_p, bat);
|
||||
|
||||
if ( u3_none != jaw ) {
|
||||
u3_assure(u3_co_is_cat(u3h(jaw)));
|
||||
|
||||
#if 0
|
||||
if ( rod_u != u3R ) {
|
||||
fprintf(stderr, "got: %x in %p/%p, %d\r\n",
|
||||
bat, rod_u, rod_u->jed.har_p, jax);
|
||||
}
|
||||
#endif
|
||||
return (c3_l)u3h(jaw);
|
||||
}
|
||||
if ( rod_u->par_u ) {
|
||||
rod_u = rod_u->par_u;
|
||||
}
|
||||
else return 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cj_find(): search for jet. `bat` is RETAINED.
|
||||
*/
|
||||
c3_l
|
||||
u3_cj_find(u3_noun bat)
|
||||
{
|
||||
return _cj_find(bat);
|
||||
}
|
||||
|
||||
/* _cj_soft(): kick softly by arm axis.
|
||||
*/
|
||||
static u3_noun
|
||||
_cj_soft(u3_noun cor, u3_noun axe)
|
||||
{
|
||||
u3_noun arm = u3_cx_at(axe, cor);
|
||||
|
||||
return u3_cn_nock_on(cor, u3k(arm));
|
||||
}
|
||||
|
||||
extern int SLAY;
|
||||
|
||||
/* _cj_kick_z(): try to kick by jet. If no kick, produce u3_none.
|
||||
**
|
||||
** `cor` is RETAINED iff there is no kick, TRANSFERRED if one.
|
||||
** `axe` is RETAINED.
|
||||
*/
|
||||
static u3_weak
|
||||
_cj_kick_z(u3_noun cor, u3_cs_core* cop_u, u3_cs_harm* ham_u, u3_atom axe)
|
||||
{
|
||||
if ( 0 == ham_u->fun_f ) {
|
||||
return u3_none;
|
||||
}
|
||||
|
||||
if ( u3_ne(ham_u->liv) ) {
|
||||
return u3_none;
|
||||
}
|
||||
else {
|
||||
if ( u3_so(ham_u->ice) ) {
|
||||
u3_weak pro = ham_u->fun_f(cor);
|
||||
|
||||
if ( u3_none != pro ) {
|
||||
u3z(cor);
|
||||
return pro;
|
||||
}
|
||||
}
|
||||
else {
|
||||
u3_weak pro, ame;
|
||||
|
||||
ham_u->ice = u3_yes;
|
||||
pro = ham_u->fun_f(u3k(cor));
|
||||
ham_u->ice = u3_no;
|
||||
|
||||
if ( u3_none == pro ) {
|
||||
u3z(cor);
|
||||
return pro;
|
||||
}
|
||||
ham_u->liv = u3_no;
|
||||
ame = _cj_soft(cor, axe);
|
||||
ham_u->liv = u3_yes;
|
||||
|
||||
if ( u3_no == u3_cr_sing(ame, pro) ) {
|
||||
fprintf(stderr, "test: %s %s: mismatch: good %x, bad %x\r\n",
|
||||
cop_u->cos_c,
|
||||
(!strcmp(".2", ham_u->fcs_c)) ? "$" : ham_u->fcs_c,
|
||||
u3_cr_mug(ame),
|
||||
u3_cr_mug(pro));
|
||||
|
||||
c3_assert(0);
|
||||
return u3_cm_bail(c3__fail);
|
||||
}
|
||||
else {
|
||||
#if 1
|
||||
fprintf(stderr, "test: %s %s\r\n",
|
||||
cop_u->cos_c,
|
||||
(!strcmp(".2", ham_u->fcs_c)) ? "$" : ham_u->fcs_c);
|
||||
#endif
|
||||
}
|
||||
}
|
||||
return u3_none;
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_hook_in(): execute hook from core, or fail.
|
||||
*/
|
||||
static u3_noun
|
||||
_cj_hook_in(u3_noun cor,
|
||||
const c3_c* tam_c,
|
||||
c3_o jet_o)
|
||||
{
|
||||
u3_noun bat = u3h(cor);
|
||||
|
||||
if ( u3_ne(u3du(cor)) ) { return u3_cm_bail(c3__fail); }
|
||||
{
|
||||
u3_weak cax = _cj_warm_fend(bat);
|
||||
|
||||
if ( u3_none == cax ) { return u3_cm_bail(c3__fail); }
|
||||
{
|
||||
u3_noun jax, pax, huc, hap;
|
||||
|
||||
u3_cx_qual(cax, &jax, &pax, &hap, &huc);
|
||||
{
|
||||
c3_l jax_l = jax;
|
||||
u3_cs_core* cop_u = &u3D.ray_u[jax_l];
|
||||
u3_noun fol = u3_ckdb_get(u3k(huc), u3_ci_string(tam_c));
|
||||
|
||||
if ( u3_none == fol ) {
|
||||
// The caller wants a deeper core.
|
||||
//
|
||||
if ( 0 == pax ) { return u3_cm_bail(c3__fail); }
|
||||
else {
|
||||
u3_noun inn = u3k(u3_cx_at(pax, cor));
|
||||
|
||||
u3z(cax); u3z(cor);
|
||||
return _cj_hook_in(inn, tam_c, jet_o);
|
||||
}
|
||||
}
|
||||
else {
|
||||
u3_noun pro;
|
||||
c3_l axe_l = _cj_axis(fol);
|
||||
c3_l inx_l;
|
||||
|
||||
if ( (0 == axe_l) ||
|
||||
(u3_no == jet_o) ||
|
||||
(u3_none == (inx_l = u3_ckdb_get(u3k(hap), axe_l))) ||
|
||||
(u3_none == (pro = _cj_kick_z(cor,
|
||||
cop_u,
|
||||
&cop_u->arm_u[inx_l],
|
||||
axe_l))) )
|
||||
{
|
||||
if ( 0 == axe_l ) {
|
||||
u3z(cax);
|
||||
return u3_cn_nock_on(cor, fol);
|
||||
} else {
|
||||
// Tricky: the above case would work here too, but would
|
||||
// disable jet_o and create some infinite recursions.
|
||||
//
|
||||
u3z(cax); u3z(fol);
|
||||
return u3_cn_nock_on(cor, u3k(u3_cx_at(axe_l, cor)));
|
||||
}
|
||||
}
|
||||
else {
|
||||
u3z(cax); u3z(fol);
|
||||
return pro;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cj_soft(): execute soft hook.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cj_soft(u3_noun cor,
|
||||
const c3_c* tam_c)
|
||||
{
|
||||
u3_noun pro;
|
||||
|
||||
pro = _cj_hook_in(cor, tam_c, u3_no);
|
||||
return pro;
|
||||
}
|
||||
|
||||
/* u3_cj_hook(): execute hook from core, or fail.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cj_hook(u3_noun cor,
|
||||
const c3_c* tam_c)
|
||||
{
|
||||
u3_noun pro;
|
||||
|
||||
pro = _cj_hook_in(cor, tam_c, u3_yes);
|
||||
return pro;
|
||||
}
|
||||
|
||||
/* u3_cj_kick(): new kick.
|
||||
**
|
||||
** `axe` is RETAINED by the caller; `cor` is RETAINED iff there
|
||||
** is no kick, TRANSFERRED if one.
|
||||
*/
|
||||
u3_weak
|
||||
u3_cj_kick(u3_noun cor, u3_noun axe)
|
||||
{
|
||||
if ( u3_ne(u3du(cor)) ) { return u3_none; }
|
||||
{
|
||||
u3_noun bat = u3h(cor);
|
||||
u3_weak cax = _cj_warm_fend(bat);
|
||||
|
||||
if ( u3_none == cax ) { return u3_none; }
|
||||
{
|
||||
u3_noun hap = u3h(u3t(u3t(cax)));
|
||||
u3_noun inx = u3_ckdb_get(u3k(hap), u3k(axe));
|
||||
|
||||
if ( u3_none == inx ) {
|
||||
u3z(cax); return u3_none;
|
||||
}
|
||||
else {
|
||||
c3_l jax_l = u3h(cax);
|
||||
u3_cs_core* cop_u = &u3D.ray_u[jax_l];
|
||||
c3_l inx_l = inx;
|
||||
u3_cs_harm* ham_u = &cop_u->arm_u[inx_l];
|
||||
u3_noun pro;
|
||||
|
||||
u3z(cax);
|
||||
pro = _cj_kick_z(cor, cop_u, ham_u, axe);
|
||||
|
||||
return pro;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cj_kink(): kick either by jet or by nock.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cj_kink(u3_noun cor,
|
||||
u3_noun axe)
|
||||
{
|
||||
u3_weak pro = u3_cj_kick(cor, axe);
|
||||
|
||||
if ( u3_none != pro ) {
|
||||
return pro;
|
||||
} else {
|
||||
return u3_cn_nock_on(cor, u3nq(9, axe, 0, 1));
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cj_mine(): register core for jets. Produce registered core.
|
||||
*/
|
||||
void
|
||||
u3_cj_mine(u3_noun clu, u3_noun cor)
|
||||
{
|
||||
_cj_warm_mine(clu, cor);
|
||||
}
|
||||
|
||||
/* _cj_cold_reap_un: re-register clog map. RETAIN but TRANSFER `sys`.
|
||||
*/
|
||||
static u3_noun
|
||||
_cj_cold_reap_un(u3_noun soh, u3_noun sab, u3_noun sys)
|
||||
{
|
||||
if ( u3_nul == sab ) {
|
||||
return sys;
|
||||
}
|
||||
else {
|
||||
u3_noun n_sab, l_sab, r_sab, pn_sab, qn_sab;
|
||||
|
||||
u3_cx_trel(sab, &n_sab, &l_sab, &r_sab);
|
||||
u3_cx_cell(n_sab, &pn_sab, &qn_sab);
|
||||
{
|
||||
sys = _cj_cold_reap_un(soh, l_sab, sys);
|
||||
sys = _cj_cold_reap_un(soh, r_sab, sys);
|
||||
sys = u3_ckdb_put(sys, u3_ca_take(pn_sab), u3k(soh));
|
||||
|
||||
return sys;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_cold_reap_to: reap clog map. RETAINS `sab`, TRANSFERS `bas`.
|
||||
*/
|
||||
static u3_noun
|
||||
_cj_cold_reap_to(u3_noun sab, u3_noun bas)
|
||||
{
|
||||
if ( u3_nul == sab ) {
|
||||
return bas;
|
||||
}
|
||||
else {
|
||||
u3_noun n_sab, l_sab, r_sab, pn_sab, qn_sab;
|
||||
|
||||
u3_cx_trel(sab, &n_sab, &l_sab, &r_sab);
|
||||
u3_cx_cell(n_sab, &pn_sab, &qn_sab);
|
||||
{
|
||||
bas = _cj_cold_reap_to(l_sab, bas);
|
||||
bas = _cj_cold_reap_to(r_sab, bas);
|
||||
|
||||
// If the battery is not junior, or if it has been
|
||||
// already collected for the product, promote it.
|
||||
//
|
||||
if ( u3_so(u3_ca_left(pn_sab)) ) {
|
||||
u3_noun bat = u3_ca_take(pn_sab);
|
||||
|
||||
bas = u3_ckdb_put(bas, bat, u3_ca_take(qn_sab));
|
||||
}
|
||||
return bas;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_cold_reap_at(): reap haw node. RETAINS.
|
||||
*/
|
||||
static void
|
||||
_cj_cold_reap_at(u3_noun soh, u3_noun cag)
|
||||
{
|
||||
u3_noun sab = _cj_cold_reap_to(u3t(cag), u3_nul);
|
||||
|
||||
if ( u3_nul != sab ) {
|
||||
u3_noun sys, haw, das;
|
||||
|
||||
soh = u3_ca_take(soh);
|
||||
cag = u3nc(u3_ca_take(u3h(cag)), sab);
|
||||
|
||||
sys = _cj_cold_reap_un(soh, sab, u3k(u3h(u3R->jed.das)));
|
||||
haw = u3_ckdb_put(u3k(u3t(u3R->jed.das)), soh, cag);
|
||||
|
||||
das = u3nc(sys, haw);
|
||||
u3z(u3R->jed.das);
|
||||
|
||||
u3R->jed.das = das;
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_cold_reap_in(): reap in (junior) haw. RETAINS.
|
||||
*/
|
||||
static void
|
||||
_cj_cold_reap_in(u3_noun taw)
|
||||
{
|
||||
if ( u3_nul != taw ) {
|
||||
u3_noun n_taw, l_taw, r_taw, pn_taw, qn_taw;
|
||||
|
||||
u3_cx_trel(taw, &n_taw, &l_taw, &r_taw);
|
||||
u3_cx_cell(n_taw, &pn_taw, &qn_taw);
|
||||
|
||||
_cj_cold_reap_at(pn_taw, qn_taw);
|
||||
_cj_cold_reap_in(l_taw);
|
||||
_cj_cold_reap_in(r_taw);
|
||||
}
|
||||
}
|
||||
|
||||
/* _cj_warm_reap(): reap key and value from warm table.
|
||||
*/
|
||||
static void
|
||||
_cj_warm_reap(u3_noun kev)
|
||||
{
|
||||
u3_noun bat = u3h(kev);
|
||||
u3_noun cax = u3t(kev);
|
||||
|
||||
if ( u3_so(u3_ca_left(bat)) ) {
|
||||
u3_noun tab = u3_ca_take(bat);
|
||||
u3_noun xac = u3_ca_take(cax);
|
||||
#if 0
|
||||
fprintf(stderr, "reap: bat %x (%d, %d), cax %x\r\n",
|
||||
u3_cr_mug(tab),
|
||||
u3_co_is_junior(u3R, bat),
|
||||
u3_ca_use(tab),
|
||||
u3_cr_mug(xac));
|
||||
#endif
|
||||
u3_ch_put(u3R->jed.har_p, tab, xac);
|
||||
u3z(tab);
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cj_reap(): promote jet state. RETAINS.
|
||||
*/
|
||||
void
|
||||
u3_cj_reap(u3_noun das, u3p(u3_ch_root) har_p)
|
||||
{
|
||||
_cj_cold_reap_in(u3t(das));
|
||||
u3_ch_walk(har_p, _cj_warm_reap);
|
||||
}
|
||||
403
g/n.c
Normal file
403
g/n.c
Normal file
@ -0,0 +1,403 @@
|
||||
/* g/n.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
extern int FOO;
|
||||
|
||||
/* _cn_hint(): process hint.
|
||||
*/
|
||||
static u3_noun
|
||||
_cn_hint(u3_noun zep,
|
||||
u3_noun hod,
|
||||
u3_noun bus,
|
||||
u3_noun nex)
|
||||
{
|
||||
switch ( zep ) {
|
||||
default: {
|
||||
// u3_cm_p("weird zep", zep);
|
||||
u3_ca_lose(zep);
|
||||
u3_ca_lose(hod);
|
||||
|
||||
return u3_cn_nock_on(bus, nex);
|
||||
}
|
||||
|
||||
case c3__hunk:
|
||||
case c3__lose:
|
||||
case c3__mean:
|
||||
case c3__spot: {
|
||||
u3_noun tac = u3nc(zep, hod);
|
||||
u3_noun pro;
|
||||
|
||||
u3_ct_push(tac);
|
||||
#if 0
|
||||
if ( c3__spot == zep ) {
|
||||
printf("spot %d/%d : %d/%d\r\n",
|
||||
u3h(u3h(u3t(hod))),
|
||||
u3t(u3h(u3t(hod))),
|
||||
u3h(u3t(u3t(hod))),
|
||||
u3t(u3t(u3t(hod))));
|
||||
}
|
||||
#endif
|
||||
pro = u3_cn_nock_on(bus, nex);
|
||||
u3_ct_drop();
|
||||
|
||||
return pro;
|
||||
}
|
||||
|
||||
case c3__slog: {
|
||||
u3_ct_slog(hod);
|
||||
return u3_cn_nock_on(bus, nex);
|
||||
}
|
||||
|
||||
case c3__germ: {
|
||||
u3_noun pro = u3_cn_nock_on(bus, nex);
|
||||
|
||||
if ( u3_yes == u3_cr_sing(pro, hod) ) {
|
||||
u3z(pro); return hod;
|
||||
} else {
|
||||
u3z(hod); return pro;
|
||||
}
|
||||
}
|
||||
|
||||
case c3__fast: {
|
||||
u3_noun pro = u3_cn_nock_on(bus, nex);
|
||||
|
||||
u3_cj_mine(hod, u3k(pro));
|
||||
return pro;
|
||||
}
|
||||
|
||||
case c3__memo: {
|
||||
u3z(hod);
|
||||
#if 0
|
||||
return u3_cn_nock_on(bus, nex);
|
||||
#else
|
||||
{
|
||||
u3_noun pro = u3_cz_find_2(c3__nock, bus, nex);
|
||||
|
||||
if ( pro != u3_none ) {
|
||||
u3z(bus); u3z(nex);
|
||||
return pro;
|
||||
}
|
||||
pro = u3_cn_nock_on(u3k(bus), u3k(nex));
|
||||
|
||||
u3_cz_save_2(c3__nock, bus, nex, pro);
|
||||
u3z(bus); u3z(nex);
|
||||
|
||||
return pro;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
case c3__sole: {
|
||||
u3z(hod);
|
||||
{
|
||||
u3_noun pro = u3_cn_nock_on(bus, nex);
|
||||
|
||||
// return u3_cz_uniq(pro);
|
||||
return pro;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
extern u3_noun BAD;
|
||||
|
||||
/* u3_cn_nock_on(): produce .*(bus fol). Do not virtualize.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cn_nock_on(u3_noun bus, u3_noun fol)
|
||||
{
|
||||
u3_noun hib, gal;
|
||||
|
||||
while ( 1 ) {
|
||||
hib = u3h(fol);
|
||||
gal = u3t(fol);
|
||||
|
||||
u3R->pro.nox_d += 1;
|
||||
|
||||
if ( u3_yes == u3_cr_du(hib) ) {
|
||||
u3_noun poz, riv;
|
||||
|
||||
poz = u3_cn_nock_on(u3k(bus), u3k(hib));
|
||||
riv = u3_cn_nock_on(bus, u3k(gal));
|
||||
|
||||
u3_ca_lose(fol);
|
||||
return u3_ci_cell(poz, riv);
|
||||
}
|
||||
else switch ( hib ) {
|
||||
default: return u3_cm_bail(c3__exit);
|
||||
|
||||
case 0: {
|
||||
if ( u3_no == u3_cr_ud(gal) ) {
|
||||
return u3_cm_bail(c3__exit);
|
||||
}
|
||||
else {
|
||||
u3_noun pro = u3k(u3at(gal, bus));
|
||||
|
||||
u3_ca_lose(bus); u3_ca_lose(fol);
|
||||
return pro;
|
||||
}
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 1: {
|
||||
u3_noun pro = u3k(gal);
|
||||
|
||||
u3_ca_lose(bus); u3_ca_lose(fol);
|
||||
return pro;
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 2: {
|
||||
u3_noun nex = u3_cn_nock_on(u3k(bus), u3k(u3t(gal)));
|
||||
u3_noun seb = u3_cn_nock_on(bus, u3k(u3h(gal)));
|
||||
|
||||
u3_ca_lose(fol);
|
||||
bus = seb;
|
||||
fol = nex;
|
||||
continue;
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 3: {
|
||||
u3_noun gof, pro;
|
||||
|
||||
gof = u3_cn_nock_on(bus, u3k(gal));
|
||||
pro = u3_cr_du(gof);
|
||||
|
||||
u3_ca_lose(gof); u3_ca_lose(fol);
|
||||
return pro;
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 4: {
|
||||
u3_noun gof, pro;
|
||||
|
||||
gof = u3_cn_nock_on(bus, u3k(gal));
|
||||
pro = u3_ci_vint(gof);
|
||||
|
||||
u3_ca_lose(fol);
|
||||
return pro;
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 5: {
|
||||
u3_noun wim = u3_cn_nock_on(bus, u3k(gal));
|
||||
u3_noun pro = u3_cr_sing(u3h(wim), u3t(wim));
|
||||
|
||||
u3_ca_lose(wim); u3_ca_lose(fol);
|
||||
return pro;
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 6: {
|
||||
u3_noun b_gal, c_gal, d_gal;
|
||||
|
||||
u3_cx_trel(gal, &b_gal, &c_gal, &d_gal);
|
||||
{
|
||||
u3_noun tys = u3_cn_nock_on(u3k(bus), u3k(b_gal));
|
||||
u3_noun nex;
|
||||
|
||||
if ( 0 == tys ) {
|
||||
nex = u3k(c_gal);
|
||||
} else if ( 1 == tys ) {
|
||||
nex = u3k(d_gal);
|
||||
} else return u3_cm_bail(c3__exit);
|
||||
|
||||
u3_ca_lose(fol);
|
||||
fol = nex;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 7: {
|
||||
u3_noun b_gal, c_gal;
|
||||
|
||||
u3_cx_cell(gal, &b_gal, &c_gal);
|
||||
{
|
||||
u3_noun bod = u3_cn_nock_on(bus, u3k(b_gal));
|
||||
u3_noun nex = u3k(c_gal);
|
||||
|
||||
u3_ca_lose(fol);
|
||||
bus = bod;
|
||||
fol = nex;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 8: {
|
||||
u3_noun b_gal, c_gal;
|
||||
|
||||
u3_cx_cell(gal, &b_gal, &c_gal);
|
||||
{
|
||||
u3_noun heb = u3_cn_nock_on(u3k(bus), u3k(b_gal));
|
||||
u3_noun bod = u3nc(heb, bus);
|
||||
u3_noun nex = u3k(c_gal);
|
||||
|
||||
u3_ca_lose(fol);
|
||||
bus = bod;
|
||||
fol = nex;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 9: {
|
||||
u3_noun b_gal, c_gal;
|
||||
|
||||
u3_cx_cell(gal, &b_gal, &c_gal);
|
||||
{
|
||||
u3_noun seb = u3_cn_nock_on(bus, u3k(c_gal));
|
||||
u3_noun pro = u3_cj_kick(seb, b_gal);
|
||||
|
||||
if ( u3_none != pro ) {
|
||||
u3_ca_lose(fol);
|
||||
return pro;
|
||||
}
|
||||
else {
|
||||
if ( u3_no == u3_cr_ud(b_gal) ) {
|
||||
return u3_cm_bail(c3__exit);
|
||||
}
|
||||
else {
|
||||
u3_noun nex = u3k(u3at(b_gal, seb));
|
||||
|
||||
u3_ca_lose(fol);
|
||||
bus = seb;
|
||||
fol = nex;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
|
||||
case 10: {
|
||||
u3_noun p_gal, q_gal;
|
||||
|
||||
u3_cx_cell(gal, &p_gal, &q_gal);
|
||||
{
|
||||
u3_noun zep, hod, nex;
|
||||
|
||||
if ( u3_yes == u3_cr_du(p_gal) ) {
|
||||
u3_noun b_gal = u3h(p_gal);
|
||||
u3_noun c_gal = u3t(p_gal);
|
||||
u3_noun d_gal = q_gal;
|
||||
|
||||
zep = u3k(b_gal);
|
||||
hod = u3_cn_nock_on(u3k(bus), u3k(c_gal));
|
||||
nex = u3k(d_gal);
|
||||
}
|
||||
else {
|
||||
u3_noun b_gal = p_gal;
|
||||
u3_noun c_gal = q_gal;
|
||||
|
||||
zep = u3k(b_gal);
|
||||
hod = u3_nul;
|
||||
nex = u3k(c_gal);
|
||||
}
|
||||
|
||||
u3_ca_lose(fol);
|
||||
return _cn_hint(zep, hod, bus, nex);
|
||||
}
|
||||
}
|
||||
|
||||
case 11: {
|
||||
u3_noun gof = u3_cn_nock_on(bus, u3k(gal));
|
||||
u3_noun val = u3_cm_soft_esc(gof);
|
||||
|
||||
if ( u3_ne(u3du(val)) ) {
|
||||
u3_cm_bail(u3nt(1, gof, 0));
|
||||
}
|
||||
else {
|
||||
u3_noun pro;
|
||||
|
||||
u3z(fol);
|
||||
pro = u3k(u3t(val));
|
||||
u3z(val);
|
||||
|
||||
return pro;
|
||||
}
|
||||
}
|
||||
c3_assert(!"not reached");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cn_kick_on(): fire `gat` without changing the sample.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cn_kick_on(u3_noun gat)
|
||||
{
|
||||
return u3_cj_kink(gat, 2);
|
||||
}
|
||||
|
||||
c3_w exc_w;
|
||||
|
||||
/* u3_cn_slam_on(): produce (gat sam).
|
||||
*/
|
||||
u3_noun
|
||||
u3_cn_slam_on(u3_noun gat, u3_noun sam)
|
||||
{
|
||||
u3_noun cor = u3nc(u3k(u3h(gat)), u3nc(sam, u3k(u3t(u3t(gat)))));
|
||||
|
||||
#if 0
|
||||
if ( &u3H->rod_u == u3R ) {
|
||||
if ( exc_w == 1 ) {
|
||||
c3_assert(0);
|
||||
}
|
||||
exc_w++;
|
||||
}
|
||||
#endif
|
||||
u3z(gat);
|
||||
return u3_cn_kick_on(cor);
|
||||
}
|
||||
|
||||
/* u3_cn_nock_un(): produce .*(bus fol), as ++toon.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cn_nock_un(u3_noun bus, u3_noun fol)
|
||||
{
|
||||
u3_noun fly = u3nt(u3nt(11, 0, 6), 0, 0); // |=(a=* .^(a))
|
||||
|
||||
return u3_cn_nock_in(fly, bus, fol);
|
||||
}
|
||||
|
||||
/* u3_cn_slam_un(): produce (gat sam), as ++toon.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cn_slam_un(u3_noun gat, u3_noun sam)
|
||||
{
|
||||
u3_noun fly = u3nt(u3nt(11, 0, 6), 0, 0); // |=(a=* .^(a))
|
||||
|
||||
return u3_cn_slam_in(fly, gat, sam);
|
||||
}
|
||||
|
||||
/* u3_cn_nock_in(): produce .*(bus fol), as ++toon, in namespace.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cn_nock_in(u3_noun fly, u3_noun bus, u3_noun fol)
|
||||
{
|
||||
return u3_cm_soft_run(fly, u3_cn_nock_on, bus, fol);
|
||||
}
|
||||
|
||||
/* u3_cn_slam_in(): produce (gat sam), as ++toon, in namespace.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cn_slam_in(u3_noun fly, u3_noun gat, u3_noun sam)
|
||||
{
|
||||
return u3_cm_soft_run(fly, u3_cn_slam_on, gat, sam);
|
||||
}
|
||||
|
||||
/* u3_cn_nock_an(): as slam_in(), but with empty fly.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cn_nock_an(u3_noun bus, u3_noun fol)
|
||||
{
|
||||
u3_noun fly = u3nt(u3nc(1, 0), 0, 0); // |=(a=* ~)
|
||||
|
||||
return u3_cn_nock_in(fly, bus, fol);
|
||||
}
|
||||
189
g/t.c
Normal file
189
g/t.c
Normal file
@ -0,0 +1,189 @@
|
||||
/* g/t.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* u3_ct_push(): push on trace stack.
|
||||
*/
|
||||
void
|
||||
u3_ct_push(u3_noun mon)
|
||||
{
|
||||
u3R->bug.tax = u3nc(mon, u3R->bug.tax);
|
||||
}
|
||||
|
||||
/* u3_ct_mean(): push `[%mean roc]` on trace stack.
|
||||
*/
|
||||
void
|
||||
u3_ct_mean(u3_noun roc)
|
||||
{
|
||||
u3R->bug.tax = u3nc(u3nc(c3__mean, roc), u3R->bug.tax);
|
||||
}
|
||||
|
||||
/* u3_ct_drop(): drop from meaning stack.
|
||||
*/
|
||||
void
|
||||
u3_ct_drop(void)
|
||||
{
|
||||
c3_assert(u3_so(u3du(u3R->bug.tax)));
|
||||
{
|
||||
u3_noun tax = u3R->bug.tax;
|
||||
|
||||
u3R->bug.tax = u3k(u3t(tax));
|
||||
u3z(tax);
|
||||
}
|
||||
}
|
||||
|
||||
extern void
|
||||
u3_lo_tank(c3_l tab_l, u3_noun tac);
|
||||
|
||||
/* u3_ct_slog(): print directly.
|
||||
*/
|
||||
void
|
||||
u3_ct_slog(u3_noun hod)
|
||||
{
|
||||
if ( u3_yes == u3du(hod) ) {
|
||||
u3_noun pri = u3h(hod);
|
||||
|
||||
switch ( pri ) {
|
||||
case 3: printf(">>> "); break;
|
||||
case 2: printf(">> "); break;
|
||||
case 1: printf("> "); break;
|
||||
}
|
||||
u3_lo_tank(0, u3k(u3t(hod)));
|
||||
}
|
||||
u3z(hod);
|
||||
}
|
||||
|
||||
/* u3_ct_heck(): profile point.
|
||||
*/
|
||||
void
|
||||
u3_ct_heck(u3_atom cog)
|
||||
{
|
||||
printf("ct: heck %s\r\n", u3_cr_string(cog));
|
||||
|
||||
if ( 0 == u3R->pro.day ) { u3R->pro.day = u3_cv_do("doss", 0); }
|
||||
|
||||
u3R->pro.day = u3_dc("pi-heck", cog, u3R->pro.day);
|
||||
}
|
||||
|
||||
/* u3_ct_samp(): sample.
|
||||
*/
|
||||
void
|
||||
u3_ct_samp(void)
|
||||
{
|
||||
if ( 0 == u3R->pro.day ) { u3R->pro.day = u3_cv_do("doss", 0); }
|
||||
|
||||
u3R->pro.day = u3_dc("pi-noon", u3k(u3R->pro.don), u3R->pro.day);
|
||||
}
|
||||
|
||||
/* u3_ct_come(): push on profile stack.
|
||||
*/
|
||||
void
|
||||
u3_ct_come(u3_atom cog)
|
||||
{
|
||||
printf("ct: come %s\r\n", u3_cr_string(cog));
|
||||
|
||||
u3R->pro.don = u3nc(cog, u3R->pro.don);
|
||||
}
|
||||
|
||||
/* u3_ct_flee(): pop off profile stack.
|
||||
*/
|
||||
void
|
||||
u3_ct_flee(void)
|
||||
{
|
||||
c3_assert(u3_so(u3du(u3R->pro.don)));
|
||||
{
|
||||
u3_noun tax = u3R->bug.tax;
|
||||
|
||||
u3R->bug.tax = u3k(u3t(tax));
|
||||
u3z(tax);
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_ct_damp(): print and clear profile data.
|
||||
*/
|
||||
void
|
||||
u3_ct_damp(void)
|
||||
{
|
||||
if ( 0 != u3R->pro.day ) {
|
||||
u3_noun wol = u3_do("pi-tell", u3R->pro.day);
|
||||
u3_cm_wall(wol);
|
||||
|
||||
u3R->pro.day = u3_cv_do("doss", 0);
|
||||
}
|
||||
|
||||
if ( 0 != u3R->pro.nox_d ) {
|
||||
printf("knox: %llu\r\n", (u3R->pro.nox_d / 1000ULL));
|
||||
u3R->pro.nox_d = 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* _ct_sigaction(): profile sigaction callback.
|
||||
*/
|
||||
void _ct_sigaction(c3_i x_i) { u3_ct_samp(); }
|
||||
|
||||
/* u3_ct_boot(): turn sampling on.
|
||||
*/
|
||||
void
|
||||
u3_ct_boot(void)
|
||||
{
|
||||
printf("ct: now profiling.\r\n");
|
||||
|
||||
printf("knox: %llu\r\n", (u3R->pro.nox_d / 1000ULL));
|
||||
u3R->pro.nox_d = 0;
|
||||
|
||||
#if defined(U2_OS_osx)
|
||||
#if 0
|
||||
{
|
||||
struct itimerval itm_v;
|
||||
struct sigaction sig_s;
|
||||
|
||||
sig_s.__sigaction_u.__sa_handler = _ct_sigaction;
|
||||
sig_s.sa_mask = 0;
|
||||
sig_s.sa_flags = 0;
|
||||
sigaction(SIGPROF, &sig_s, 0);
|
||||
|
||||
itm_v.it_interval.tv_sec = 0;
|
||||
itm_v.it_interval.tv_usec = 10000;
|
||||
itm_v.it_value = itm_v.it_interval;
|
||||
|
||||
setitimer(ITIMER_PROF, &itm_v, 0);
|
||||
}
|
||||
#endif
|
||||
#elif defined(U2_OS_linux)
|
||||
// TODO: support profiling on linux
|
||||
#elif defined(U2_OS_bsd)
|
||||
// TODO: support profiling on bsd
|
||||
#else
|
||||
#error "port: profiling"
|
||||
#endif
|
||||
}
|
||||
|
||||
/* u3_ct_boff(): turn profile sampling off.
|
||||
*/
|
||||
void
|
||||
u3_ct_boff(void)
|
||||
{
|
||||
#if defined(U2_OS_osx)
|
||||
struct sigaction sig_s;
|
||||
struct itimerval itm_v;
|
||||
|
||||
printf("ct: end profiling.\r\n");
|
||||
|
||||
itm_v.it_interval.tv_sec = 0;
|
||||
itm_v.it_interval.tv_usec = 0;
|
||||
itm_v.it_value = itm_v.it_interval;
|
||||
|
||||
setitimer(ITIMER_PROF, &itm_v, 0);
|
||||
sigaction(SIGPROF, &sig_s, 0);
|
||||
|
||||
u3_ct_damp();
|
||||
#elif defined(U2_OS_linux)
|
||||
// TODO: support profiling on linux
|
||||
#elif defined(U2_OS_bsd)
|
||||
// TODO: support profiling on bsd
|
||||
#else
|
||||
#error "port: profiling"
|
||||
#endif
|
||||
}
|
||||
531
g/v.c
Normal file
531
g/v.c
Normal file
@ -0,0 +1,531 @@
|
||||
/* g/v.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include <stdio.h>
|
||||
#include "all.h"
|
||||
|
||||
int WISH;
|
||||
/* _cv_nock_wish(): call wish through hardcoded interface.
|
||||
*/
|
||||
static u3_noun
|
||||
_cv_nock_wish(u3_noun txt)
|
||||
{
|
||||
u3_noun fun, pro;
|
||||
|
||||
WISH = 1;
|
||||
fun = u3_cn_nock_on(u3k(u3A->roc), u3k(u3_cx_at(20, u3A->roc)));
|
||||
pro = u3_cn_slam_on(fun, txt);
|
||||
WISH = 0;
|
||||
|
||||
return pro;
|
||||
}
|
||||
|
||||
/* u3_cv_make(): make a new pier and instantiate pill.
|
||||
*/
|
||||
void
|
||||
u3_cv_make(c3_c* pas_c)
|
||||
{
|
||||
u3_noun sys = u3_cke_cue(u3_cm_file(pas_c));
|
||||
|
||||
printf("cv_make: loaded pill %s, as %x\n", pas_c, u3_cr_mug(sys));
|
||||
|
||||
u3A->ken = u3k(u3h(sys));
|
||||
u3A->roc = u3k(u3t(sys));
|
||||
|
||||
printf("cv_make: kernel %x, core %x\n",
|
||||
u3_cr_mug(u3A->ken), u3_cr_mug(u3A->roc));
|
||||
u3z(sys);
|
||||
}
|
||||
|
||||
int JACK;
|
||||
|
||||
/* u3_cv_jack(): execute kernel formula to bind jets.
|
||||
*/
|
||||
void
|
||||
u3_cv_jack(void)
|
||||
{
|
||||
u3_noun cor;
|
||||
|
||||
JACK = 1;
|
||||
printf("cv_jack: activating kernel %x\n", u3_cr_mug(u3A->ken));
|
||||
cor = u3_cn_nock_on(0, u3k(u3A->ken));
|
||||
printf("cv_jack: activated\n");
|
||||
JACK = 0;
|
||||
|
||||
u3z(cor);
|
||||
}
|
||||
|
||||
/* u3_cv_hose(): clear initial ovum queue.
|
||||
*/
|
||||
void
|
||||
u3_cv_hose(void)
|
||||
{
|
||||
u3p(u3_cs_cart) egg_p = u3A->ova.egg_p;
|
||||
|
||||
while ( egg_p ) {
|
||||
u3_cs_cart* egg_u = u3to(u3_cs_cart, egg_p);
|
||||
u3p(u3_cs_cart) nex_p = egg_u->nex_p;
|
||||
|
||||
u3_ca_lose(egg_u->vir);
|
||||
u3_ca_free(egg_u);
|
||||
|
||||
egg_p = nex_p;
|
||||
}
|
||||
u3A->ova.egg_p = u3A->ova.geg_p = 0;
|
||||
u3z(u3A->roe);
|
||||
u3A->roe = u3_nul;
|
||||
}
|
||||
|
||||
/* u3_cv_start(): start time.
|
||||
*/
|
||||
void
|
||||
u3_cv_start(u3_noun now)
|
||||
{
|
||||
u3_cv_time(now);
|
||||
u3_cv_numb();
|
||||
|
||||
{
|
||||
c3_c* wen_c = u3_cr_string(u3A->wen);
|
||||
|
||||
printf("cv_start: time: %s\n", wen_c);
|
||||
free(wen_c);
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cv_wish(): text expression with cache.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cv_wish(const c3_c* str_c)
|
||||
{
|
||||
u3_noun exp;
|
||||
|
||||
if ( u3R == &u3H->rod_u ) {
|
||||
u3_noun txt = u3_ci_string(str_c);
|
||||
|
||||
exp = u3_ckdb_get(u3k(u3A->yot), u3k(txt));
|
||||
|
||||
if ( u3_none == exp ) {
|
||||
exp = _cv_nock_wish(u3k(txt));
|
||||
u3A->yot = u3_ckdb_put(u3A->yot, u3k(txt), u3k(exp));
|
||||
}
|
||||
u3z(txt);
|
||||
return exp;
|
||||
}
|
||||
else {
|
||||
// It's probably not a good idea to use u3_cv_wish()
|
||||
// outside the top level...
|
||||
//
|
||||
return _cv_nock_wish(u3_ci_string(str_c));
|
||||
}
|
||||
}
|
||||
|
||||
/* _cv_mung(): formula wrapper with gate and sample.
|
||||
*/
|
||||
static u3_noun
|
||||
_cv_mung_in(u3_noun gam)
|
||||
{
|
||||
u3_noun pro = u3_cn_slam_on(u3k(u3h(gam)), u3k(u3t(gam)));
|
||||
|
||||
u3z(gam); return pro;
|
||||
}
|
||||
static u3_noun
|
||||
_cv_mung(c3_w sec_w, u3_noun gat, u3_noun sam)
|
||||
{
|
||||
u3_noun gam = u3nc(gat, sam);
|
||||
|
||||
return u3_cm_soft(0, _cv_mung_in, gam);
|
||||
}
|
||||
|
||||
/* u3_cv_pike(): poke with floating core.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cv_pike(u3_noun ovo, u3_noun cor)
|
||||
{
|
||||
u3_noun fun = u3_cn_nock_on(cor, u3k(u3_cx_at(42, cor)));
|
||||
u3_noun sam = u3nc(u3k(u3A->now), ovo);
|
||||
|
||||
return _cv_mung(0, fun, sam);
|
||||
}
|
||||
|
||||
/* u3_cv_nick(): transform enveloped packets, [vir cor].
|
||||
*/
|
||||
u3_noun
|
||||
u3_cv_nick(u3_noun vir, u3_noun cor)
|
||||
{
|
||||
if ( u3_nul == vir ) {
|
||||
return u3nt(u3_blip, vir, cor);
|
||||
}
|
||||
else {
|
||||
u3_noun i_vir = u3h(vir);
|
||||
u3_noun pi_vir, qi_vir;
|
||||
u3_noun vix;
|
||||
|
||||
if ( (u3_yes == u3_cr_cell((i_vir=u3h(vir)), &pi_vir, &qi_vir)) &&
|
||||
(u3_yes == u3du(qi_vir)) &&
|
||||
(c3__hear == u3h(qi_vir)) )
|
||||
{
|
||||
u3_noun gon;
|
||||
|
||||
gon = u3_cv_pike(u3k(i_vir), cor);
|
||||
if ( u3_blip != u3h(gon) ) {
|
||||
u3z(vir);
|
||||
return gon;
|
||||
}
|
||||
else {
|
||||
u3_noun viz;
|
||||
|
||||
vix = u3k(u3h(u3t(gon)));
|
||||
cor = u3k(u3t(u3t(gon)));
|
||||
u3z(gon);
|
||||
|
||||
viz = u3_ckb_weld(vix, u3k(u3t(vir)));
|
||||
u3z(vir);
|
||||
|
||||
return u3_cv_nick(viz, cor);
|
||||
}
|
||||
}
|
||||
else {
|
||||
u3_noun nez = u3_cv_nick(u3k(u3t(vir)), cor);
|
||||
|
||||
if ( u3_blip != u3h(nez) ) {
|
||||
u3z(vir);
|
||||
return nez;
|
||||
} else {
|
||||
u3_noun viz;
|
||||
|
||||
viz = u3nc(u3k(i_vir), u3k(u3h(u3t(nez))));
|
||||
cor = u3k(u3t(u3t(nez)));
|
||||
|
||||
u3z(vir);
|
||||
u3z(nez);
|
||||
|
||||
return u3nt(u3_blip, viz, cor);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* _cv_nock_poke(): call poke through hardcoded interface.
|
||||
*/
|
||||
static u3_noun
|
||||
_cv_nock_poke(u3_noun ovo)
|
||||
{
|
||||
u3_noun fun = u3_cn_nock_on(u3k(u3A->roc), u3k(u3_cx_at(42, u3A->roc)));
|
||||
u3_noun sam, pro;
|
||||
|
||||
sam = u3nc(u3k(u3A->now), ovo);
|
||||
#if 0
|
||||
{
|
||||
c3_c* ovi_c = u3_cr_string(u3h(u3t(ovo)));
|
||||
u3_noun tox = u3_do("spat", u3k(u3h(ovo)));
|
||||
c3_c* tox_c = u3_cr_string(tox);
|
||||
|
||||
printf("poke: %%%s (%x) on %s\r\n", ovi_c, u3_cr_mug(ovo), tox_c);
|
||||
free(tox_c); free(ovi_c); u3z(tox);
|
||||
}
|
||||
#endif
|
||||
|
||||
// u3_leak_on(1);
|
||||
pro = u3_cn_slam_on(fun, sam);
|
||||
// u3_leak_off;
|
||||
|
||||
#if 0
|
||||
{
|
||||
c3_c* ovi_c = u3_cr_string(u3h(u3t(ovo)));
|
||||
|
||||
printf("poked: %s\r\n", ovi_c);
|
||||
|
||||
free(ovi_c);
|
||||
}
|
||||
#endif
|
||||
|
||||
return pro;
|
||||
}
|
||||
|
||||
/* _cv_nock_peek(): call peek through hardcoded interface.
|
||||
*/
|
||||
static u3_noun
|
||||
_cv_nock_peek(u3_noun hap)
|
||||
{
|
||||
u3_noun fun = u3_cn_nock_on(u3k(u3A->roc), u3k(u3_cx_at(87, u3A->roc)));
|
||||
u3_noun sam = u3nc(u3k(u3A->now), hap);
|
||||
|
||||
return u3_cn_slam_on(fun, sam);
|
||||
}
|
||||
|
||||
/* _cv_nock_keep(): call wait through hardcoded interface.
|
||||
*/
|
||||
static u3_noun
|
||||
_cv_nock_keep(u3_noun hap)
|
||||
{
|
||||
u3_noun fun = u3_cn_nock_on(u3k(u3A->roc), u3k(u3_cx_at(4, u3A->roc)));
|
||||
u3_noun sam = u3nc(u3k(u3A->now), hap);
|
||||
|
||||
return u3_cn_slam_on(fun, sam);
|
||||
}
|
||||
|
||||
/* u3_cv_do(): use a kernel gate.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cv_do(const c3_c* txt_c, u3_noun sam)
|
||||
{
|
||||
u3_noun gat = u3_cv_wish(txt_c);
|
||||
u3_noun pro;
|
||||
|
||||
#if 0
|
||||
if ( &u3H->rod_u == u3R ) {
|
||||
pro = u3_cm_soft_slam(gat, sam);
|
||||
}
|
||||
else {
|
||||
pro = u3_cn_slam_on(gat, sam);
|
||||
}
|
||||
#else
|
||||
pro = u3_cn_slam_on(gat, sam);
|
||||
#endif
|
||||
|
||||
return pro;
|
||||
}
|
||||
|
||||
/* _cv_scot(): print atom.
|
||||
*/
|
||||
static u3_noun
|
||||
_cv_scot(u3_noun dim)
|
||||
{
|
||||
return u3_do("scot", dim);
|
||||
}
|
||||
|
||||
/* u3_cv_time(): set the reck time.
|
||||
*/
|
||||
void
|
||||
u3_cv_time(u3_noun now)
|
||||
{
|
||||
u3z(u3A->now);
|
||||
u3A->now = now;
|
||||
|
||||
u3z(u3A->wen);
|
||||
u3A->wen = _cv_scot(u3nc(c3__da, u3k(u3A->now)));
|
||||
}
|
||||
|
||||
/* u3_cv_numb(): set the instance number.
|
||||
*/
|
||||
void
|
||||
u3_cv_numb()
|
||||
{
|
||||
u3A->sev_l = u3_cr_mug(u3A->now);
|
||||
u3z(u3A->sen);
|
||||
u3A->sen = _cv_scot(u3nc(c3__uv, u3A->sev_l));
|
||||
}
|
||||
|
||||
#if 0
|
||||
/* _cv_time_bump(): advance the reck time by a small increment.
|
||||
*/
|
||||
static void
|
||||
_cv_time_bump(u3_reck* rec_u)
|
||||
{
|
||||
c3_d bum_d = (1ULL << 48ULL);
|
||||
|
||||
u3A->now = u3_cka_add(u3A->now, u3_ci_chubs(1, &bum_d));
|
||||
}
|
||||
#endif
|
||||
|
||||
/* u3_cv_peek(): query the reck namespace (protected).
|
||||
*/
|
||||
u3_noun
|
||||
u3_cv_peek(u3_noun hap)
|
||||
{
|
||||
return u3_cm_soft_sure(_cv_nock_peek, hap);
|
||||
}
|
||||
|
||||
/* u3_cv_keep(): measure timer.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cv_keep(u3_noun hap)
|
||||
{
|
||||
return u3_cm_soft_sure(_cv_nock_keep, hap);
|
||||
}
|
||||
|
||||
#if 0
|
||||
/* _cv_mole(): parse simple atomic mole.
|
||||
*/
|
||||
static u3_bean
|
||||
_cv_mole(u3_noun fot,
|
||||
u3_noun san,
|
||||
c3_d* ato_d)
|
||||
{
|
||||
u3_noun uco = u3_do("slay", san);
|
||||
u3_noun p_uco, q_uco, r_uco, s_uco;
|
||||
|
||||
if ( (u3_no == u3_cr_qual(uco, &p_uco, &q_uco, &r_uco, &s_uco)) ||
|
||||
(0 != p_uco) ||
|
||||
(0 != q_uco) ||
|
||||
(u3_no == u3_sing(fot, r_uco)) )
|
||||
{
|
||||
uL(fprintf(uH, "strange mole %s\n", u3_cr_string(san)));
|
||||
|
||||
u3z(fot); u3z(uco); return u3_no;
|
||||
}
|
||||
else {
|
||||
*ato_d = u3_cr_chub(0, s_uco);
|
||||
|
||||
u3z(fot); u3z(uco); return u3_yes;
|
||||
}
|
||||
}
|
||||
|
||||
/* _cv_lily(): parse little atom.
|
||||
*/
|
||||
static u3_bean
|
||||
_cv_lily(u3_noun fot, u3_noun txt, c3_l* tid_l)
|
||||
{
|
||||
c3_d ato_d;
|
||||
|
||||
if ( u3_no == _cv_mole(fot, txt, &ato_d) ) {
|
||||
return u3_no;
|
||||
} else {
|
||||
if ( ato_d >= 0x80000000ULL ) {
|
||||
return u3_no;
|
||||
} else {
|
||||
*tid_l = (c3_l) ato_d;
|
||||
|
||||
return u3_yes;
|
||||
}
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* u3_cv_poke(): insert and apply an input ovum (protected).
|
||||
*/
|
||||
u3_noun
|
||||
u3_cv_poke(u3_noun ovo)
|
||||
{
|
||||
return _cv_nock_poke(ovo);
|
||||
}
|
||||
|
||||
/* u3_cv_http_request(): hear http request on channel (unprotected).
|
||||
*/
|
||||
void
|
||||
u3_cv_http_request(u3_bean sec, u3_noun pox, u3_noun req)
|
||||
{
|
||||
// uL(fprintf(uH, "http: request\n"));
|
||||
u3_cv_plan(pox, u3nq(c3__this, sec, 0, req));
|
||||
}
|
||||
|
||||
/* u3_cv_tank(): dump single tank.
|
||||
*/
|
||||
void
|
||||
u3_cv_tank(u3_noun blu, c3_l tab_l, u3_noun tac)
|
||||
{
|
||||
u3_cv_punt(blu, tab_l, u3nc(tac, u3_nul));
|
||||
}
|
||||
|
||||
/* u3_cv_punt(): dump tank list.
|
||||
*/
|
||||
void
|
||||
u3_cv_punt(u3_noun blu, c3_l tab_l, u3_noun tac)
|
||||
{
|
||||
#if 0
|
||||
u3_noun blu = u3_term_get_blew(0);
|
||||
#endif
|
||||
c3_l col_l = u3h(blu);
|
||||
u3_noun cat = tac;
|
||||
|
||||
// We are calling nock here, but hopefully need no protection.
|
||||
//
|
||||
while ( u3_yes == u3_cr_du(cat) ) {
|
||||
u3_noun wol = u3_dc("wash", u3nc(tab_l, col_l), u3k(u3h(cat)));
|
||||
|
||||
u3_cm_wall(wol);
|
||||
cat = u3t(cat);
|
||||
}
|
||||
u3z(tac);
|
||||
u3z(blu);
|
||||
}
|
||||
|
||||
/* u3_cv_sway(): print trace.
|
||||
*/
|
||||
void
|
||||
u3_cv_sway(u3_noun blu, c3_l tab_l, u3_noun tax)
|
||||
{
|
||||
u3_noun mok = u3_dc("mook", 2, tax);
|
||||
|
||||
u3_cv_punt(blu, tab_l, u3k(u3t(mok)));
|
||||
u3z(mok);
|
||||
}
|
||||
|
||||
/* u3_cv_plan(): queue ovum (external).
|
||||
*/
|
||||
void
|
||||
u3_cv_plan(u3_noun pax, u3_noun fav)
|
||||
{
|
||||
u3_noun egg = u3nc(pax, fav);
|
||||
u3A->roe = u3nc(u3nc(u3_nul, egg), u3A->roe);
|
||||
}
|
||||
|
||||
/* u3_cv_plow(): queue multiple ova (external).
|
||||
*/
|
||||
void
|
||||
u3_cv_plow(u3_noun ova)
|
||||
{
|
||||
u3_noun ovi = ova;
|
||||
|
||||
while ( u3_nul != ovi ) {
|
||||
u3_noun ovo=u3h(ovi);
|
||||
|
||||
u3_cv_plan(u3k(u3h(ovo)), u3k(u3t(ovo)));
|
||||
ovi = u3t(ovi);
|
||||
}
|
||||
u3z(ova);
|
||||
}
|
||||
|
||||
/* u3_cv_louse(): last-minute deviltry upon a bail.
|
||||
*/
|
||||
void
|
||||
u3_cv_louse(c3_m how_m)
|
||||
{
|
||||
#if 0
|
||||
if ( c3__exit == how_m ) {
|
||||
printf("louse: nocks: %d\n", NOX);
|
||||
printf("louse: washing kernel %x %d\n", u3A->ken, u3_co_is_dog(u3A->ken));
|
||||
u3_cm_wash(u3A->ken);
|
||||
|
||||
printf("kernel %x; washed mug %x\n", u3A->ken, u3_cr_mug(u3A->ken));
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/* _cv_mark_ova(): mark ova queue.
|
||||
*/
|
||||
static void
|
||||
_cv_mark_ova(u3p(u3_cs_cart) egg_p)
|
||||
{
|
||||
while ( egg_p ) {
|
||||
u3_cs_cart* egg_u = u3to(u3_cs_cart, egg_p);
|
||||
|
||||
u3_ca_mark_ptr(egg_u);
|
||||
u3_ca_mark_noun(egg_u->vir);
|
||||
|
||||
egg_p = egg_u->nex_p;
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cv_mark(): mark arvo kernel.
|
||||
*/
|
||||
void
|
||||
u3_cv_mark(void)
|
||||
{
|
||||
u3_cs_arvo* arv_u = &(u3H->arv_u);
|
||||
|
||||
u3_ca_mark_noun(arv_u->yot);
|
||||
u3_ca_mark_noun(arv_u->now);
|
||||
u3_ca_mark_noun(arv_u->wen);
|
||||
u3_ca_mark_noun(arv_u->sen);
|
||||
u3_ca_mark_noun(arv_u->own);
|
||||
|
||||
u3_ca_mark_noun(arv_u->roe);
|
||||
u3_ca_mark_noun(arv_u->key);
|
||||
|
||||
u3_ca_mark_noun(arv_u->ken);
|
||||
u3_ca_mark_noun(arv_u->roc);
|
||||
|
||||
_cv_mark_ova(arv_u->ova.egg_p);
|
||||
}
|
||||
91
g/x.c
Normal file
91
g/x.c
Normal file
@ -0,0 +1,91 @@
|
||||
/* g/x.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* u3_cx_good(): test for u3_none.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cx_good(u3_weak som)
|
||||
{
|
||||
if ( u3_none == som ) {
|
||||
return u3_cm_bail(c3__exit);
|
||||
}
|
||||
else return som;
|
||||
}
|
||||
|
||||
/* u3_cx_at (u3at): fragment.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cx_at(u3_noun axe, u3_noun som)
|
||||
{
|
||||
u3_weak pro = u3_cr_at(axe, som);
|
||||
|
||||
if ( u3_none == pro ) {
|
||||
return u3_cm_bail(c3__exit);
|
||||
} else return pro;
|
||||
}
|
||||
|
||||
/* u3_cx_cell():
|
||||
**
|
||||
** Divide `a` as a cell `[b c]`.
|
||||
*/
|
||||
void
|
||||
u3_cx_cell(u3_noun a,
|
||||
u3_noun* b,
|
||||
u3_noun* c)
|
||||
{
|
||||
if ( u3_no == u3_cr_cell(a, b, c) ) {
|
||||
u3_cm_bail(c3__exit);
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cx_trel():
|
||||
**
|
||||
** Divide `a` as a trel `[b c d]`, or bail.
|
||||
*/
|
||||
void
|
||||
u3_cx_trel(u3_noun a,
|
||||
u3_noun* b,
|
||||
u3_noun* c,
|
||||
u3_noun* d)
|
||||
{
|
||||
if ( u3_no == u3_cr_trel(a, b, c, d) ) {
|
||||
u3_cm_bail(c3__exit);
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cx_qual():
|
||||
**
|
||||
** Divide `a` as a quadruple `[b c d e]`.
|
||||
*/
|
||||
void
|
||||
u3_cx_qual(u3_noun a,
|
||||
u3_noun* b,
|
||||
u3_noun* c,
|
||||
u3_noun* d,
|
||||
u3_noun* e)
|
||||
{
|
||||
if ( u3_no == u3_cr_qual(a, b, c, d, e) ) {
|
||||
u3_cm_bail(c3__exit);
|
||||
}
|
||||
}
|
||||
|
||||
/* u3_cx_quil():
|
||||
**
|
||||
** Divide `a` as a quintuple `[b c d e f]`.
|
||||
*/
|
||||
void
|
||||
u3_cx_quil(u3_noun a,
|
||||
u3_noun* b,
|
||||
u3_noun* c,
|
||||
u3_noun* d,
|
||||
u3_noun* e,
|
||||
u3_noun* f)
|
||||
{
|
||||
if ( u3_no == u3_cr_quil(a, b, c, d, e, f) ) {
|
||||
u3_cm_bail(c3__exit);
|
||||
}
|
||||
}
|
||||
|
||||
109
g/z.c
Normal file
109
g/z.c
Normal file
@ -0,0 +1,109 @@
|
||||
/* g/z.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
|
||||
/* u3_cz_find(): find in memo cache. Arguments retained.
|
||||
*/
|
||||
u3_weak
|
||||
u3_cz_find(u3_mote fun, u3_noun one)
|
||||
{
|
||||
u3_noun key = u3nc(fun, u3k(one));
|
||||
u3_noun val;
|
||||
|
||||
val = u3_ch_get(u3R->cax.har_p, key);
|
||||
u3z(key);
|
||||
return val;
|
||||
}
|
||||
u3_weak
|
||||
u3_cz_find_2(u3_mote fun, u3_noun one, u3_noun two)
|
||||
{
|
||||
u3_noun key = u3nt(fun, u3k(one), u3k(two));
|
||||
u3_noun val;
|
||||
|
||||
val = u3_ch_get(u3R->cax.har_p, key);
|
||||
u3z(key);
|
||||
return val;
|
||||
}
|
||||
u3_weak
|
||||
u3_cz_find_3(u3_mote fun, u3_noun one, u3_noun two, u3_noun tri)
|
||||
{
|
||||
u3_noun key = u3nq(fun, u3k(one), u3k(two), u3k(tri));
|
||||
u3_noun val;
|
||||
|
||||
val = u3_ch_get(u3R->cax.har_p, key);
|
||||
u3z(key);
|
||||
return val;
|
||||
}
|
||||
u3_weak
|
||||
u3_cz_find_4(u3_mote fun, u3_noun one, u3_noun two, u3_noun tri, u3_noun qua)
|
||||
{
|
||||
u3_noun key = u3nc(fun, u3nq(u3k(one), u3k(two), u3k(tri), u3k(qua)));
|
||||
u3_noun val;
|
||||
|
||||
val = u3_ch_get(u3R->cax.har_p, key);
|
||||
u3z(key);
|
||||
return val;
|
||||
}
|
||||
|
||||
/* u3_cz_save*(): save in memo cache.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cz_save(u3_mote fun, u3_noun one, u3_noun val)
|
||||
{
|
||||
u3_noun key = u3nc(fun, u3k(one));
|
||||
|
||||
u3_ch_put(u3R->cax.har_p, key, u3k(val));
|
||||
u3z(key);
|
||||
return val;
|
||||
}
|
||||
u3_noun
|
||||
u3_cz_save_2(u3_mote fun, u3_noun one, u3_noun two, u3_noun val)
|
||||
{
|
||||
u3_noun key = u3nt(fun, u3k(one), u3k(two));
|
||||
|
||||
u3_ch_put(u3R->cax.har_p, key, u3k(val));
|
||||
u3z(key);
|
||||
return val;
|
||||
}
|
||||
u3_noun
|
||||
u3_cz_save_3(u3_mote fun, u3_noun one, u3_noun two, u3_noun tri, u3_noun val)
|
||||
{
|
||||
u3_noun key = u3nq(fun, u3k(one), u3k(two), u3k(tri));
|
||||
|
||||
u3_ch_put(u3R->cax.har_p, key, u3k(val));
|
||||
u3z(key);
|
||||
return val;
|
||||
}
|
||||
u3_noun
|
||||
u3_cz_save_4(u3_mote fun,
|
||||
u3_noun one,
|
||||
u3_noun two,
|
||||
u3_noun tri,
|
||||
u3_noun qua,
|
||||
u3_noun val)
|
||||
{
|
||||
u3_noun key = u3nc(fun, u3nq(u3k(one), u3k(two), u3k(tri), u3k(qua)));
|
||||
|
||||
u3_ch_put(u3R->cax.har_p, key, u3k(val));
|
||||
u3z(key);
|
||||
return val;
|
||||
}
|
||||
|
||||
/* u3_cz_uniq(): uniquify with memo cache.
|
||||
*/
|
||||
u3_noun
|
||||
u3_cz_uniq(u3_noun som)
|
||||
{
|
||||
u3_noun key = u3nc(c3__uniq, u3k(som));
|
||||
u3_noun val = u3_ch_get(u3R->cax.har_p, key);
|
||||
|
||||
if ( u3_none != val ) {
|
||||
u3z(key); u3z(som); return val;
|
||||
}
|
||||
else {
|
||||
u3_ch_put(u3R->cax.har_p, key, u3k(som));
|
||||
return som;
|
||||
}
|
||||
}
|
||||
@ -1,47 +0,0 @@
|
||||
/* j/1/add.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, add)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
mpz_t a_mp, b_mp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
u2_mp(b_mp, b);
|
||||
|
||||
mpz_add(a_mp, a_mp, b_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return u2_rl_mp(wir_r, a_mp);
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, add)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, add)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, add)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, add), u2_jet_live, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,55 +0,0 @@
|
||||
/* j/1/dec.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, inc)(u2_wire wir_r,
|
||||
u2_atom a) // retain
|
||||
{
|
||||
return u2_rl_vint(wir_r, u2_rx(wir_r, a));
|
||||
}
|
||||
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, dec)(u2_wire wir_r,
|
||||
u2_atom a) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return u2_bl_error(wir_r, "decrement-underflow");
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
mpz_t a_mp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
mpz_sub_ui(a_mp, a_mp, 1);
|
||||
|
||||
return u2_rl_mp(wir_r, a_mp);
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, dec)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a;
|
||||
|
||||
if ( (u2_none == (a = u2_frag(u2_cv_sam, cor))) ||
|
||||
(u2_no == u2_stud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, dec)(wir_r, a);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, dec)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, dec), u2_jet_live, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,52 +0,0 @@
|
||||
/* j/1/div.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, div)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
if ( _0 == b ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
mpz_t a_mp, b_mp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
u2_mp(b_mp, b);
|
||||
|
||||
mpz_tdiv_q(a_mp, a_mp, b_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return u2_rl_mp(wir_r, a_mp);
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, div)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, div)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, div)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, div), u2_jet_live, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,50 +0,0 @@
|
||||
/* j/1/gte.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, gte)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
mpz_t a_mp, b_mp;
|
||||
u2_bean cmp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
u2_mp(b_mp, b);
|
||||
|
||||
cmp = (mpz_cmp(a_mp, b_mp) >= 0) ? u2_yes : u2_no;
|
||||
|
||||
mpz_clear(a_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return cmp;
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, gte)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, gte)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, gte)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, gte), Tier1, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,50 +0,0 @@
|
||||
/* j/1/gth.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, gth)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
mpz_t a_mp, b_mp;
|
||||
u2_bean cmp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
u2_mp(b_mp, b);
|
||||
|
||||
cmp = (mpz_cmp(a_mp, b_mp) > 0) ? u2_yes : u2_no;
|
||||
|
||||
mpz_clear(a_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return cmp;
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, gth)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, gth)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, gth)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, gth), Tier1, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,50 +0,0 @@
|
||||
/* j/1/lte.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, lte)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
mpz_t a_mp, b_mp;
|
||||
u2_bean cmp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
u2_mp(b_mp, b);
|
||||
|
||||
cmp = (mpz_cmp(a_mp, b_mp) <= 0) ? u2_yes : u2_no;
|
||||
|
||||
mpz_clear(a_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return cmp;
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, lte)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, lte)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, lte)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, lte), Tier1, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,50 +0,0 @@
|
||||
/* j/1/lth.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, lth)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
mpz_t a_mp, b_mp;
|
||||
u2_bean cmp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
u2_mp(b_mp, b);
|
||||
|
||||
cmp = (mpz_cmp(a_mp, b_mp) < 0) ? u2_yes : u2_no;
|
||||
|
||||
mpz_clear(a_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return cmp;
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, lth)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, lth)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, lth)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, lth), Tier1, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,51 +0,0 @@
|
||||
/* j/1/mod.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, mod)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
if ( _0 == b ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
mpz_t a_mp, b_mp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
u2_mp(b_mp, b);
|
||||
|
||||
mpz_tdiv_r(a_mp, a_mp, b_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return u2_rl_mp(wir_r, a_mp);
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, mod)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, mod)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, mod)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, mod), Tier1, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,48 +0,0 @@
|
||||
/* j/1/mul.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, mul)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
mpz_t a_mp, b_mp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
u2_mp(b_mp, b);
|
||||
|
||||
mpz_mul(a_mp, a_mp, b_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return u2_rl_mp(wir_r, a_mp);
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, mul)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, mul)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, mul)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, mul), u2_jet_live, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
@ -1,53 +0,0 @@
|
||||
/* j/1/sub.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt1, sub)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
mpz_t a_mp, b_mp;
|
||||
|
||||
u2_mp(a_mp, a);
|
||||
u2_mp(b_mp, b);
|
||||
|
||||
if ( mpz_cmp(a_mp, b_mp) < 0 ) {
|
||||
mpz_clear(a_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return u2_bl_error(wir_r, "subtract-underflow");
|
||||
}
|
||||
mpz_sub(a_mp, a_mp, b_mp);
|
||||
mpz_clear(b_mp);
|
||||
|
||||
return u2_rl_mp(wir_r, a_mp);
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt1, sub)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt1, sub)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt1, sub)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt1, sub), u2_jet_live, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,41 +0,0 @@
|
||||
/* j/2/bind.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, bind)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return _0;
|
||||
} else {
|
||||
return u2_ru(wir_r, u2_nk_mong(wir_r, b, u2_rx(wir_r, u2_st(a))));
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, bind)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, bind)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, bind)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, bind), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
@ -1,50 +0,0 @@
|
||||
/* j/2/clap.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, clap)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun c) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return u2_rx(wir_r, b);
|
||||
}
|
||||
else if ( _0 == b ) {
|
||||
return u2_rx(wir_r, a);
|
||||
}
|
||||
else {
|
||||
return u2_ru
|
||||
(wir_r,
|
||||
u2_nk_mong(wir_r, c, u2_rc(wir_r, u2_rx(wir_r, u2_st(a)),
|
||||
u2_rx(wir_r, u2_st(b)))));
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, clap)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b, c;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a,
|
||||
u2_cv_sam_6, &b,
|
||||
u2_cv_sam_7, &c, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, clap)(wir_r, a, b, c);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, clap)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, clap), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,41 +0,0 @@
|
||||
/* j/2/drop.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, drop)(u2_wire wir_r,
|
||||
u2_noun a) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return u2_nul;
|
||||
}
|
||||
else {
|
||||
return u2_ro(wir_r, u2_rx(wir_r, u2_st(a)));
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, drop)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a;
|
||||
|
||||
if ( u2_none == (a = u2_frag(u2_cv_sam, cor)) ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
return j2_mbc(Pt2, drop)(wir_r, a);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, drop)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, drop), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
@ -1,50 +0,0 @@
|
||||
/* j/2/flop.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, flop)(u2_wire wir_r,
|
||||
u2_noun a) // retain
|
||||
{
|
||||
u2_weak b = _0;
|
||||
|
||||
while ( 1 ) {
|
||||
if ( u2_nul == a ) {
|
||||
return b;
|
||||
}
|
||||
else if ( u2_no == u2_dust(a) ) {
|
||||
u2_rl_lose(wir_r, b);
|
||||
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
b = u2_rc(wir_r, u2_rx(wir_r, u2_h(a)), b);
|
||||
a = u2_t(a);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt2, flop)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a;
|
||||
|
||||
if ( u2_none == (a = u2_frag(u2_cv_sam, cor)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, flop)(wir_r, a);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, flop)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, flop), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,49 +0,0 @@
|
||||
/* j/2/lent.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, lent)(u2_wire wir_r,
|
||||
u2_noun a) // retain
|
||||
{
|
||||
u2_weak len = _0;
|
||||
|
||||
while ( 1 ) {
|
||||
if ( _0 == a ) {
|
||||
return len;
|
||||
}
|
||||
else if ( u2_no == u2_dust(a) ) {
|
||||
u2_rl_lose(wir_r, len);
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
len = u2_rl_vint(wir_r, len);
|
||||
a = u2_t(a);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_noun
|
||||
j2_mb(Pt2, lent)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a;
|
||||
|
||||
if ( u2_none == (a = u2_frag(u2_cv_sam, cor)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, lent)(wir_r, a);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, lent)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, lent), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,50 +0,0 @@
|
||||
/* j/2/levy.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, levy)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return u2_yes;
|
||||
} else {
|
||||
u2_weak loz;
|
||||
|
||||
if ( u2_no == u2_dust(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else switch ( (loz = u2_nk_mong(wir_r, b, u2_rx(wir_r, u2_h(a)))) ) {
|
||||
case u2_yes: return j2_mbc(Pt2, levy)(wir_r, u2_t(a), b);
|
||||
case u2_no: return u2_no;
|
||||
default: u2_rl_lose(wir_r, loz);
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, levy)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, levy)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, levy)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, levy), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,50 +0,0 @@
|
||||
/* j/2/lien.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, lien)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return u2_no;
|
||||
} else {
|
||||
u2_weak loz;
|
||||
|
||||
if ( u2_no == u2_dust(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else switch ( (loz = u2_nk_mong(wir_r, b, u2_rx(wir_r, u2_h(a)))) ) {
|
||||
case u2_yes: return u2_yes;
|
||||
case u2_no: return j2_mbc(Pt2, lien)(wir_r, u2_t(a), b);
|
||||
default: u2_rl_lose(wir_r, loz);
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, lien)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, lien)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, lien)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, lien), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,40 +0,0 @@
|
||||
/* j/2/need.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, need)(u2_wire wir_r,
|
||||
u2_noun a) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
return u2_rx(wir_r, u2_st(a));
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, need)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a;
|
||||
|
||||
if ( u2_none == (a = u2_frag(u2_cv_sam, cor)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, need)(wir_r, a);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, need)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, need), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,48 +0,0 @@
|
||||
/* j/2/reel.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, reel)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return u2_rx(wir_r, u2_frag(u2_cv_sam_3, b));
|
||||
}
|
||||
else if ( u2_no == u2_dust(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
u2_weak gim = u2_rx(wir_r, u2_h(a));
|
||||
u2_weak hur = j2_mbc(Pt2, reel)(wir_r, u2_t(a), b);
|
||||
|
||||
return u2_nk_mong(wir_r, b, u2_rc(wir_r, gim, hur));
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, reel)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, reel)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, reel)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, reel), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
@ -1,56 +0,0 @@
|
||||
/* j/2/roll.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, roll)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return u2_rx(wir_r, u2_frag(u2_cv_sam_3, b));
|
||||
}
|
||||
else if ( u2_no == u2_dust(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
u2_weak gim = u2_rx(wir_r, u2_h(a));
|
||||
u2_weak zor = u2_rx(wir_r, u2_frag(u2_cv_sam_3, b));
|
||||
u2_weak daz = u2_nk_mong(wir_r, b, u2_rc(wir_r, gim, zor));
|
||||
u2_weak vel = u2_rl_molt(wir_r, b, u2_cv_sam_3, daz, 0);
|
||||
|
||||
if ( u2_none == vel ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
u2_weak hox = j2_mbc(Pt2, roll)(wir_r, u2_t(a), vel);
|
||||
|
||||
u2_rl_lose(wir_r, vel);
|
||||
return hox;
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, roll)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, roll)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, roll)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, roll), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,64 +0,0 @@
|
||||
/* j/2/scag.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, scag)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
u2_noun acc;
|
||||
c3_w i_w = a;
|
||||
|
||||
if ( !i_w )
|
||||
return u2_nul;
|
||||
|
||||
while ( i_w ) {
|
||||
if ( u2_no == u2_dust(b) ) {
|
||||
return u2_nul;
|
||||
}
|
||||
acc = u2_cn_cell( u2_h(b), acc );
|
||||
b = u2_t(b);
|
||||
i_w--;
|
||||
}
|
||||
|
||||
return u2_ckb_flop(acc);
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, scag)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, scag)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
/* u2_ho_jet */
|
||||
/* j2_mbj(Pt2, scag)[] = { */
|
||||
/* { ".2", c3__lite, j2_mb(Pt2, scag), u2_jet_dead, u2_none, u2_none }, */
|
||||
/* { } */
|
||||
/* }; */
|
||||
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, scag)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, scag), u2_jet_dead, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,53 +0,0 @@
|
||||
/* j/2/skim.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, skim)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return a;
|
||||
}
|
||||
else if ( u2_no == u2_dust(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
u2_weak hoz = u2_nk_mong(wir_r, b, u2_rx(wir_r, u2_h(a)));
|
||||
u2_weak vyr = j2_mbc(Pt2, skim)(wir_r, u2_t(a), b);
|
||||
|
||||
switch ( hoz ) {
|
||||
case u2_yes: return u2_rc(wir_r, u2_rx(wir_r, u2_h(a)), vyr);
|
||||
case u2_no: return vyr;
|
||||
default: u2_rl_lose(wir_r, hoz);
|
||||
u2_rl_lose(wir_r, vyr);
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, skim)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, skim)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, skim)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, skim), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
@ -1,52 +0,0 @@
|
||||
/* j/2/skip.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, skip)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return a;
|
||||
}
|
||||
else if ( u2_no == u2_dust(a) ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
u2_weak hoz = u2_nk_mong(wir_r, b, u2_rx(wir_r, u2_h(a)));
|
||||
u2_weak vyr = j2_mbc(Pt2, skip)(wir_r, u2_t(a), b);
|
||||
|
||||
switch ( hoz ) {
|
||||
case u2_yes: return vyr;
|
||||
case u2_no: return u2_rc(wir_r, u2_rx(wir_r, u2_h(a)), vyr);
|
||||
default: u2_rl_lose(wir_r, hoz);
|
||||
u2_rl_lose(wir_r, vyr);
|
||||
return u2_none;
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, skip)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_none;
|
||||
} else {
|
||||
return j2_mbc(Pt2, skip)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, skip)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, skip), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,52 +0,0 @@
|
||||
/* j/2/slag.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, slag)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
c3_w len_w = a;
|
||||
|
||||
while ( len_w ) {
|
||||
if ( u2_no == u2_dust(b) ) {
|
||||
return u2_nul;
|
||||
}
|
||||
b = u2_t(b);
|
||||
len_w--;
|
||||
}
|
||||
return u2_rx(wir_r, b);
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, slag)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, slag)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, slag)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, slag), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,55 +0,0 @@
|
||||
/* j/2/snag.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, snag)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
c3_w len_w = a;
|
||||
|
||||
while ( len_w ) {
|
||||
if ( u2_no == u2_dust(b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
b = u2_t(b);
|
||||
len_w--;
|
||||
}
|
||||
if ( u2_no == u2_dust(b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
return u2_rx(wir_r, u2_h(b));
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, snag)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, snag)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, snag)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, snag), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,38 +0,0 @@
|
||||
/* j/2/sort.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, sort)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
// must think about
|
||||
//
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, sort)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, sort)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, sort)[] = {
|
||||
{ ".2", c3__lite, u2_jet_dead, Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,47 +0,0 @@
|
||||
/* j/2/turn.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, turn)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return a;
|
||||
}
|
||||
else if ( u2_no == u2_dust(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
u2_noun one = u2_nk_mong(wir_r, b, u2_rx(wir_r, u2_h(a)));
|
||||
u2_noun two = j2_mbc(Pt2, turn)(wir_r, u2_t(a), b);
|
||||
|
||||
return u2_rc(wir_r, one, two);
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, turn)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, turn)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, turn)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, turn), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,47 +0,0 @@
|
||||
/* j/2/weld.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt2, weld)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( _0 == a ) {
|
||||
return u2_rx(wir_r, b);
|
||||
}
|
||||
else if ( u2_no == u2_dust(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
return u2_rc
|
||||
(wir_r,
|
||||
u2_rx(wir_r, u2_h(a)),
|
||||
j2_mbc(Pt2, weld)(wir_r, u2_t(a), b));
|
||||
}
|
||||
}
|
||||
u2_noun // transfer
|
||||
j2_mb(Pt2, weld)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt2, weld)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt2, weld)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt2, weld), Tier2, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,47 +0,0 @@
|
||||
/* j/3/bex.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, bex)(u2_wire wir_r,
|
||||
u2_atom a) // retain
|
||||
{
|
||||
mpz_t a_mp;
|
||||
|
||||
if ( !u2_fly_is_cat(a) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
mpz_init_set_ui(a_mp, 1);
|
||||
mpz_mul_2exp(a_mp, a_mp, a);
|
||||
|
||||
return u2_rl_mp(wir_r, a_mp);
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, bex)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a;
|
||||
|
||||
if ( (u2_none == (a = u2_frag(u2_cv_sam, cor))) ||
|
||||
(u2_no == u2_stud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, bex)(wir_r, a);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, bex)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, bex), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,95 +0,0 @@
|
||||
/* j/3/can.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_noun // transfer
|
||||
j2_mbc(Pt3, can)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) || (a >= 32) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
c3_g a_g = a;
|
||||
c3_w tot_w = 0;
|
||||
u2_ray sal_r;
|
||||
|
||||
/* Measure and validate the slab required.
|
||||
*/
|
||||
{
|
||||
u2_noun cab = b;
|
||||
|
||||
while ( 1 ) {
|
||||
u2_noun i_cab, pi_cab, qi_cab;
|
||||
|
||||
if ( _0 == cab ) {
|
||||
break;
|
||||
}
|
||||
if ( (u2_no == u2_dust(cab)) ||
|
||||
(u2_no == u2_dust(i_cab = u2_h(cab))) ||
|
||||
!(u2_fly_is_cat(pi_cab = u2_h(i_cab))) ||
|
||||
u2_no == u2_stud(qi_cab = u2_t(i_cab)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else if ( (tot_w + pi_cab) < tot_w ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
tot_w += pi_cab;
|
||||
cab = u2_t(cab);
|
||||
}
|
||||
if ( 0 == tot_w ) {
|
||||
return _0;
|
||||
}
|
||||
if ( 0 == (sal_r = u2_rl_slaq(wir_r, a_g, tot_w)) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
}
|
||||
|
||||
/* Chop the list atoms in.
|
||||
*/
|
||||
{
|
||||
u2_noun cab = b;
|
||||
c3_w pos_w = 0;
|
||||
|
||||
while ( _0 != cab ) {
|
||||
u2_noun i_cab = u2_h(cab);
|
||||
u2_atom pi_cab = u2_h(i_cab);
|
||||
u2_atom qi_cab = u2_t(i_cab);
|
||||
|
||||
u2_chop(a_g, 0, pi_cab, pos_w, sal_r, qi_cab);
|
||||
pos_w += pi_cab;
|
||||
cab = u2_t(cab);
|
||||
}
|
||||
}
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, can)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
} else {
|
||||
return j2_mbc(Pt3, can)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, can)[] = {
|
||||
{ ".2", c3__hevy, j2_mb(Pt3, can), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,46 +0,0 @@
|
||||
/* j/3/cap.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, cap)(u2_wire wir_r,
|
||||
u2_atom a) // retain
|
||||
{
|
||||
c3_w met_w = u2_met(0, a);
|
||||
|
||||
if ( met_w < 2 ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( (1 == u2_bit((met_w - 2), a)) ) {
|
||||
return _3;
|
||||
} else {
|
||||
return _2;
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, cap)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a;
|
||||
|
||||
if ( (u2_none == (a = u2_frag(u2_cv_sam, cor))) ||
|
||||
(u2_no == u2_stud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, cap)(wir_r, a);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, cap)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, cap), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,69 +0,0 @@
|
||||
/* j/3/cat.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, cat)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b, // retain
|
||||
u2_atom c) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) || (a >= 32) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
c3_g a_g = a;
|
||||
c3_w lew_w = u2_met(a_g, b);
|
||||
c3_w ler_w = u2_met(a_g, c);
|
||||
c3_w all_w = (lew_w + ler_w);
|
||||
|
||||
if ( 0 == all_w ) {
|
||||
return 0;
|
||||
} else {
|
||||
u2_ray sal_r = u2_rl_slaq(wir_r, a_g, all_w);
|
||||
|
||||
if ( 0 == sal_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
u2_chop(a_g, 0, lew_w, 0, sal_r, b);
|
||||
u2_chop(a_g, 0, ler_w, lew_w, sal_r, c);
|
||||
}
|
||||
// return u2_rl_moot(wir_r, sal_r);
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, cat)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b, c;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a,
|
||||
u2_cv_sam_6, &b,
|
||||
u2_cv_sam_7, &c, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) ||
|
||||
(u2_no == u2_stud(c)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, cat)(wir_r, a, b, c);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, cat)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, cat), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
@ -1,62 +0,0 @@
|
||||
/* j/3/con.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, con)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
c3_w lna_w = u2_met(5, a);
|
||||
c3_w lnb_w = u2_met(5, b);
|
||||
|
||||
if ( (lna_w == 0) && (lnb_w == 0) ) {
|
||||
return _0;
|
||||
} else {
|
||||
c3_w len_w = c3_max(lna_w, lnb_w);
|
||||
u2_ray sal_r = u2_rl_slab(wir_r, len_w);
|
||||
|
||||
if ( 0 == sal_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
c3_w i_w;
|
||||
|
||||
u2_chop(5, 0, lna_w, 0, sal_r, a);
|
||||
|
||||
for ( i_w = 0; i_w < lnb_w; i_w++ ) {
|
||||
*u2_at_ray(sal_r + i_w) |= u2_atom_word(b, i_w);
|
||||
}
|
||||
// return u2_rl_moot(wir_r, sal_r);
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, con)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, con)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, con)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, con), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,81 +0,0 @@
|
||||
/* j/3/cut.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, cut)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b, // retain
|
||||
u2_atom c, // retain
|
||||
u2_atom d) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) || (a >= 32) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
if ( !u2_fly_is_cat(b) ) {
|
||||
return _0;
|
||||
}
|
||||
if ( !u2_fly_is_cat(c) ) {
|
||||
c = 0x7fffffff;
|
||||
}
|
||||
|
||||
{
|
||||
c3_g a_g = a;
|
||||
c3_w b_w = b;
|
||||
c3_w c_w = c;
|
||||
c3_w len_w = u2_met(a_g, d);
|
||||
|
||||
if ( (_0 == c_w) || (b_w >= len_w) ) {
|
||||
return _0;
|
||||
}
|
||||
if ( b_w + c_w > len_w ) {
|
||||
c_w = (len_w - b_w);
|
||||
}
|
||||
if ( (b_w == 0) && (c_w == len_w) ) {
|
||||
return u2_rx(wir_r, d);
|
||||
}
|
||||
else {
|
||||
u2_ray sal_r = u2_rl_slaq(wir_r, a_g, c_w);
|
||||
|
||||
if ( 0 == sal_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
u2_chop(a_g, b_w, c_w, 0, sal_r, d);
|
||||
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, cut)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b, c, d;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a,
|
||||
u2_cv_sam_12, &b,
|
||||
u2_cv_sam_13, &c,
|
||||
u2_cv_sam_7, &d, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) ||
|
||||
(u2_no == u2_stud(c)) ||
|
||||
(u2_no == u2_stud(d)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, cut)(wir_r, a, b, c, d);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, cut)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, cut), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,61 +0,0 @@
|
||||
/* j/3/dis.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, dis)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
c3_w lna_w = u2_met(5, a);
|
||||
c3_w lnb_w = u2_met(5, b);
|
||||
|
||||
if ( (lna_w == 0) && (lnb_w == 0) ) {
|
||||
return _0;
|
||||
} else {
|
||||
c3_w len_w = c3_max(lna_w, lnb_w);
|
||||
u2_ray sal_r = u2_rl_slab(wir_r, len_w);
|
||||
|
||||
if ( 0 == sal_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
c3_w i_w;
|
||||
|
||||
u2_chop(5, 0, lna_w, 0, sal_r, a);
|
||||
|
||||
for ( i_w = 0; i_w < len_w; i_w++ ) {
|
||||
*u2_at_ray(sal_r + i_w) &= (i_w >= lnb_w) ? 0 : u2_atom_word(b, i_w);
|
||||
}
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, dis)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, dis)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, dis)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, dis), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,59 +0,0 @@
|
||||
/* j/3/dor.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, dor)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
if ( u2_yes == u2_sing(a, b) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == u2_stud(a) ) {
|
||||
if ( u2_yes == u2_stud(b) ) {
|
||||
return j2_mbc(Pt1, lth)(wir_r, a, b);
|
||||
}
|
||||
else {
|
||||
return u2_yes;
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == u2_stud(b) ) {
|
||||
return u2_no;
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == u2_sing(u2_h(a), u2_h(b)) ) {
|
||||
return j2_mbc(Pt3, dor)(wir_r, u2_t(a), u2_t(b));
|
||||
}
|
||||
else return j2_mbc(Pt3, dor)(wir_r, u2_h(a), u2_h(b));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, dor)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, dor)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, dor)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, dor), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,70 +0,0 @@
|
||||
/* j/3/end.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, end)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b, // retain
|
||||
u2_atom c) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) || (a >= 32) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else if ( !u2_fly_is_cat(b) ) {
|
||||
return u2_rx(wir_r, c);
|
||||
}
|
||||
else {
|
||||
c3_g a_g = a;
|
||||
c3_w b_w = b;
|
||||
c3_w len_w = u2_met(a_g, c);
|
||||
|
||||
if ( _0 == b_w ) {
|
||||
return _0;
|
||||
}
|
||||
else if ( b_w >= len_w ) {
|
||||
return u2_rx(wir_r, c);
|
||||
}
|
||||
else {
|
||||
u2_ray sal_r = u2_rl_slaq(wir_r, a_g, b_w);
|
||||
|
||||
if ( 0 == sal_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
u2_chop(a_g, 0, b_w, 0, sal_r, c);
|
||||
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, end)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b, c;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a,
|
||||
u2_cv_sam_6, &b,
|
||||
u2_cv_sam_7, &c, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) ||
|
||||
(u2_no == u2_stud(c)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, end)(wir_r, a, b, c);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, end)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, end), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,42 +0,0 @@
|
||||
/* j/3/gor.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, gor)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
c3_w c_w = u2_mug(a);
|
||||
c3_w d_w = u2_mug(b);
|
||||
|
||||
if ( c_w == d_w ) {
|
||||
return j2_mbc(Pt3, dor)(wir_r, a, b);
|
||||
}
|
||||
else return (c_w < d_w) ? u2_yes : u2_no;
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, gor)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, gor)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, gor)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, gor), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,56 +0,0 @@
|
||||
/* j/3/hor.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, hor)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_yes == u2_stud(a) ) {
|
||||
if ( u2_yes == u2_stud(b) ) {
|
||||
return j2_mbc(Pt3, gor)(wir_r, a, b);
|
||||
} else {
|
||||
return u2_yes;
|
||||
}
|
||||
} else {
|
||||
if ( u2_yes == u2_stud(b) ) {
|
||||
return u2_no;
|
||||
}
|
||||
else {
|
||||
u2_noun h_a = u2_h(a);
|
||||
u2_noun h_b = u2_h(b);
|
||||
|
||||
if ( u2_yes == u2_sing(h_a, h_b) ) {
|
||||
return j2_mbc(Pt3, gor)(wir_r, u2_t(a), u2_t(b));
|
||||
} else {
|
||||
return j2_mbc(Pt3, gor)(wir_r, h_a, h_b);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, hor)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, hor)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, hor)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, hor), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,71 +0,0 @@
|
||||
/* j/3/lsh.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, lsh)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b, // retain
|
||||
u2_atom c) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) || (a >= 32) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else if ( !u2_fly_is_cat(b) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
c3_g a_g = a;
|
||||
c3_w b_w = b;
|
||||
c3_w len_w = u2_met(a_g, c);
|
||||
|
||||
if ( _0 == len_w ) {
|
||||
return _0;
|
||||
}
|
||||
else if ( (b_w + len_w) < len_w ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
u2_ray sal_r = u2_rl_slaq(wir_r, a_g, (b_w + len_w));
|
||||
|
||||
if ( 0 == sal_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
u2_chop(a_g, 0, len_w, b_w, sal_r, c);
|
||||
|
||||
// return u2_rl_moot(wir_r, sal_r);
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, lsh)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b, c;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a,
|
||||
u2_cv_sam_6, &b,
|
||||
u2_cv_sam_7, &c, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) ||
|
||||
(u2_no == u2_stud(c)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, lsh)(wir_r, a, b, c);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, lsh)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, lsh), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,55 +0,0 @@
|
||||
/* j/3/mas.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, mas)(u2_wire wir_r,
|
||||
u2_atom a) // retain
|
||||
{
|
||||
c3_w b_w;
|
||||
u2_atom c, d, e, f;
|
||||
|
||||
b_w = u2_met(0, a);
|
||||
if ( b_w < 2 ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
c = j2_mbc(Pt3, bex)(wir_r, (b_w - 1));
|
||||
d = j2_mbc(Pt3, bex)(wir_r, (b_w - 2));
|
||||
e = j2_mbc(Pt1, sub)(wir_r, a, c);
|
||||
f = j2_mbc(Pt3, con)(wir_r, e, d);
|
||||
|
||||
u2_rl_lose(wir_r, c);
|
||||
u2_rl_lose(wir_r, d);
|
||||
u2_rl_lose(wir_r, e);
|
||||
|
||||
return f;
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, mas)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a;
|
||||
|
||||
if ( (u2_none == (a = u2_frag(u2_cv_sam, cor))) ||
|
||||
(u2_no == u2_stud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, mas)(wir_r, a);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, mas)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, mas), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,51 +0,0 @@
|
||||
/* j/3/met.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, met)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) || (a >= 32) ) {
|
||||
if ( _0 == b ) {
|
||||
return _0;
|
||||
} else return _1;
|
||||
}
|
||||
else {
|
||||
c3_w met_w = u2_met(a, b);
|
||||
|
||||
if ( !u2_fly_is_cat(met_w) ) {
|
||||
return u2_rl_words(wir_r, 1, &met_w);
|
||||
}
|
||||
else return u2_met(a, b);
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, met)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, met)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, met)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, met), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,61 +0,0 @@
|
||||
/* j/3/mix.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, mix)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
c3_w lna_w = u2_met(5, a);
|
||||
c3_w lnb_w = u2_met(5, b);
|
||||
|
||||
if ( (lna_w == 0) && (lnb_w == 0) ) {
|
||||
return _0;
|
||||
} else {
|
||||
c3_w len_w = c3_max(lna_w, lnb_w);
|
||||
u2_ray sal_r = u2_rl_slab(wir_r, len_w);
|
||||
|
||||
if ( 0 == sal_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
c3_w i_w;
|
||||
|
||||
u2_chop(5, 0, lna_w, 0, sal_r, a);
|
||||
|
||||
for ( i_w = 0; i_w < lnb_w; i_w++ ) {
|
||||
*u2_at_ray(sal_r + i_w) ^= u2_atom_word(b, i_w);
|
||||
}
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, mix)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, mix)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, mix)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, mix), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,29 +0,0 @@
|
||||
/* j/3/mug.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, mug)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun sam;
|
||||
|
||||
if ( u2_none == (sam = u2_frag(u2_cv_sam, cor)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return u2_mug(sam);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, mug)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, mug), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,75 +0,0 @@
|
||||
/* j/3/mur.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, mum)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun sam;
|
||||
|
||||
if ( u2_none == (sam = u2_frag(u2_cv_sam, cor)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return u2_mum(sam);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, mum)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, mum),
|
||||
u2_jet_test | u2_jet_live, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, mur)(u2_wire wir_r,
|
||||
u2_atom syd, // retain
|
||||
u2_atom key) // retain
|
||||
{
|
||||
c3_w syd_w = u2_cr_word(0, syd);
|
||||
c3_w len_w = u2_cr_met(5, key);
|
||||
{
|
||||
c3_w* key_w = alloca(4 * len_w);
|
||||
c3_w goc_w;
|
||||
|
||||
u2_cr_words(0, len_w, key_w, key);
|
||||
goc_w = u2_mur_words(syd_w, len_w, key_w);
|
||||
|
||||
return u2_ci_words(1, &goc_w);
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, mur)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, mur)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, mur)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, mur),
|
||||
u2_jet_test | u2_jet_live, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,56 +0,0 @@
|
||||
/* j/3/peg.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, peg)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
u2_atom c, d, e, f, g, h;
|
||||
|
||||
c = u2_met(0, b);
|
||||
d = j2_mbc(Pt1, dec)(wir_r, c);
|
||||
e = j2_mbc(Pt3, lsh)(wir_r, _0, d, 1);
|
||||
f = j2_mbc(Pt1, sub)(wir_r, b, e);
|
||||
g = j2_mbc(Pt3, lsh)(wir_r, _0, d, a);
|
||||
h = j2_mbc(Pt1, add)(wir_r, f, g);
|
||||
|
||||
u2_rl_lose(wir_r, c);
|
||||
u2_rl_lose(wir_r, d);
|
||||
u2_rl_lose(wir_r, e);
|
||||
u2_rl_lose(wir_r, f);
|
||||
u2_rl_lose(wir_r, g);
|
||||
|
||||
return h;
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, peg)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) ||
|
||||
(0 == a) ||
|
||||
(0 == b) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, peg)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, peg)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, peg), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
150
gen164/3/po.c
150
gen164/3/po.c
@ -1,150 +0,0 @@
|
||||
/* j/3/po.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
// good old linear search
|
||||
//
|
||||
static u2_noun
|
||||
_po_find(u2_noun buf, u2_noun a)
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) ) {
|
||||
return u2_nul;
|
||||
}
|
||||
else {
|
||||
c3_w i_w;
|
||||
c3_w a_w = a;
|
||||
|
||||
for ( i_w = 0; i_w < 256; i_w++ ) {
|
||||
c3_y byt_y[3];
|
||||
c3_w but_w;
|
||||
|
||||
u2_cr_bytes((i_w * 3), 3, byt_y, buf);
|
||||
but_w = (byt_y[0] | (byt_y[1] << 8) | (byt_y[2] << 16));
|
||||
|
||||
if ( but_w == a_w ) {
|
||||
return u2nc(u2_nul, i_w);
|
||||
}
|
||||
}
|
||||
return u2_nul;
|
||||
}
|
||||
}
|
||||
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt3, po, ins)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun x, a, buf;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam, &a, u2_cv_con_sam, &x, 0)) ||
|
||||
(u2_no == u2du(x)) ||
|
||||
(u2_no == u2ud(buf = u2h(x))) ||
|
||||
(u2_no == u2ud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return _po_find(buf, a);
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt3, po, ind)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun x, a, buf;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam, &a, u2_cv_con_sam, &x, 0)) ||
|
||||
(u2_no == u2du(x)) ||
|
||||
(u2_no == u2ud(buf = u2t(x))) ||
|
||||
(u2_no == u2ud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return _po_find(buf, a);
|
||||
}
|
||||
}
|
||||
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt3, po, tos)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun x, a, buf;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam, &a, u2_cv_con_sam, &x, 0)) ||
|
||||
(u2_no == u2du(x)) ||
|
||||
(u2_no == u2ud(buf = u2h(x))) ||
|
||||
(u2_no == u2ud(a)) ||
|
||||
(a >= 256) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
c3_y byt_y[3];
|
||||
|
||||
u2_cr_bytes((a * 3), 3, byt_y, buf);
|
||||
return (byt_y[0] | (byt_y[1] << 8) | (byt_y[2] << 16));
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt3, po, tod)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun x, a, buf;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam, &a, u2_cv_con_sam, &x, 0)) ||
|
||||
(u2_no == u2du(x)) ||
|
||||
(u2_no == u2ud(buf = u2t(x))) ||
|
||||
(u2_no == u2ud(a)) ||
|
||||
(a >= 256) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
c3_y byt_y[3];
|
||||
|
||||
u2_cr_bytes((a * 3), 3, byt_y, buf);
|
||||
return (byt_y[0] | (byt_y[1] << 8) | (byt_y[2] << 16));
|
||||
}
|
||||
}
|
||||
|
||||
/* declarations
|
||||
*/
|
||||
// # define crap u2_jet_dead
|
||||
# define crap u2_jet_test | u2_jet_live
|
||||
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt3, po, ind)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt3, po, ind), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt3, po, ins)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt3, po, ins), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt3, po, tod)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt3, po, tod), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt3, po, tos)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt3, po, tos), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_driver
|
||||
j2_mbd(Pt3, po)[] = {
|
||||
{ j2_sc(Pt3, po, ind), j2_mcj(Pt3, po, ind), 0, 0, u2_none },
|
||||
{ j2_sc(Pt3, po, ins), j2_mcj(Pt3, po, ins), 0, 0, u2_none },
|
||||
{ j2_sc(Pt3, po, tod), j2_mcj(Pt3, po, tod), 0, 0, u2_none },
|
||||
{ j2_sc(Pt3, po, tos), j2_mcj(Pt3, po, tos), 0, 0, u2_none },
|
||||
{}
|
||||
};
|
||||
|
||||
u2_ho_driver
|
||||
j2_db(Pt3, po) =
|
||||
{ j2_sb(Pt3, po), 0, j2_mbd(Pt3, po), 0, u2_none };
|
||||
@ -1,95 +0,0 @@
|
||||
/* j/3/rap.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, rap)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) || (a >= 32) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
c3_g a_g = a;
|
||||
c3_w tot_w = 0;
|
||||
u2_ray sal_r;
|
||||
|
||||
/* Measure and validate the slab required.
|
||||
*/
|
||||
{
|
||||
u2_noun cab = b;
|
||||
|
||||
while ( 1 ) {
|
||||
u2_noun h_cab;
|
||||
c3_w len_w;
|
||||
|
||||
if ( _0 == cab ) {
|
||||
break;
|
||||
}
|
||||
else if ( u2_no == u2_dust(cab) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_stud(h_cab = u2_h(cab)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( (tot_w + (len_w = u2_met(a_g, h_cab))) < tot_w ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
tot_w += len_w;
|
||||
cab = u2_t(cab);
|
||||
}
|
||||
if ( 0 == tot_w ) {
|
||||
return _0;
|
||||
}
|
||||
if ( 0 == (sal_r = u2_rl_slaq(wir_r, a_g, tot_w)) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
}
|
||||
|
||||
/* Chop the list atoms in.
|
||||
*/
|
||||
{
|
||||
u2_noun cab = b;
|
||||
c3_w pos_w = 0;
|
||||
|
||||
while ( _0 != cab ) {
|
||||
u2_noun h_cab = u2_h(cab);
|
||||
c3_w len_w = u2_met(a_g, h_cab);
|
||||
|
||||
u2_chop(a_g, 0, len_w, pos_w, sal_r, h_cab);
|
||||
pos_w += len_w;
|
||||
cab = u2_t(cab);
|
||||
}
|
||||
}
|
||||
// return u2_rl_moot(wir_r, sal_r);
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, rap)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, rap)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, rap)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, rap), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,94 +0,0 @@
|
||||
/* j/3/rip.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, rip)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) || (a >= 32) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else {
|
||||
u2_noun pir = u2_nul;
|
||||
c3_g a_g = a;
|
||||
c3_w i_w;
|
||||
|
||||
if ( a_g < 5 ) {
|
||||
c3_w met_w = u2_met(a_g, b);
|
||||
c3_w mek_w = ((1 << (1 << a_g)) - 1);
|
||||
|
||||
for ( i_w = 0; i_w < met_w; i_w++ ) {
|
||||
c3_w pat_w = (met_w - (i_w + 1));
|
||||
c3_w bit_w = (pat_w << a_g);
|
||||
c3_w wor_w = (bit_w >> 5);
|
||||
c3_w sif_w = (bit_w & 31);
|
||||
c3_w src_w = u2_atom_word(b, wor_w);
|
||||
c3_w rip_w = ((src_w >> sif_w) & mek_w);
|
||||
|
||||
pir = u2_rc(wir_r, rip_w, pir);
|
||||
}
|
||||
return pir;
|
||||
}
|
||||
else {
|
||||
c3_w met_w = u2_met(a_g, b);
|
||||
c3_w len_w = u2_met(5, b);
|
||||
c3_g san_g = (a_g - 5);
|
||||
c3_w san_w = 1 << san_g;
|
||||
c3_w dif_w = (met_w << san_g) - len_w;
|
||||
c3_w tub_w = ((dif_w == 0) ? san_w : (san_w - dif_w));
|
||||
|
||||
for ( i_w = 0; i_w < met_w; i_w++ ) {
|
||||
c3_w pat_w = (met_w - (i_w + 1));
|
||||
c3_w wut_w = (pat_w << san_g);
|
||||
c3_w sap_w = ((0 == i_w) ? tub_w : san_w);
|
||||
u2_ray sal_r = u2_rl_slab(wir_r, sap_w);
|
||||
|
||||
if ( 0 == sal_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
} else {
|
||||
c3_w j_w;
|
||||
u2_atom rip;
|
||||
|
||||
for ( j_w = 0; j_w < sap_w; j_w++ ) {
|
||||
*u2_at_ray(sal_r + j_w) = u2_atom_word(b, wut_w + j_w);
|
||||
}
|
||||
|
||||
rip = u2_rl_malt(wir_r, sal_r);
|
||||
pir = u2_rc(wir_r, rip, pir);
|
||||
}
|
||||
len_w -= san_w;
|
||||
}
|
||||
}
|
||||
return pir;
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, rip)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, rip)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, rip)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, rip), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,68 +0,0 @@
|
||||
/* j/3/rsh.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, rsh)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b, // retain
|
||||
u2_atom c) // retain
|
||||
{
|
||||
if ( !u2_fly_is_cat(a) || (a >= 32) ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
else if ( !u2_fly_is_cat(b) ) {
|
||||
return _0;
|
||||
}
|
||||
else {
|
||||
c3_g a_g = a;
|
||||
c3_w b_w = b;
|
||||
c3_w len_w = u2_met(a_g, c);
|
||||
|
||||
if ( b_w >= len_w ) {
|
||||
return _0;
|
||||
}
|
||||
else {
|
||||
u2_ray sal_r = u2_rl_slaq(wir_r, a_g, (len_w - b_w));
|
||||
|
||||
if ( 0 == sal_r ) {
|
||||
return u2_bl_bail(wir_r, c3__fail);
|
||||
}
|
||||
u2_chop(a_g, b_w, (len_w - b_w), 0, sal_r, c);
|
||||
|
||||
// return u2_rl_moot(wir_r, sal_r);
|
||||
return u2_rl_malt(wir_r, sal_r);
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, rsh)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b, c;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a,
|
||||
u2_cv_sam_6, &b,
|
||||
u2_cv_sam_7, &c, 0)) ||
|
||||
(u2_no == u2_stud(a)) ||
|
||||
(u2_no == u2_stud(b)) ||
|
||||
(u2_no == u2_stud(c)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, rsh)(wir_r, a, b, c);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, rsh)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, rsh), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,42 +0,0 @@
|
||||
/* j/3/vor.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mbc(Pt3, vor)(u2_wire wir_r,
|
||||
u2_atom a, // retain
|
||||
u2_atom b) // retain
|
||||
{
|
||||
c3_w c_w = u2_mug(u2_mug(a));
|
||||
c3_w d_w = u2_mug(u2_mug(b));
|
||||
|
||||
if ( c_w == d_w ) {
|
||||
return j2_mbc(Pt3, dor)(wir_r, a, b);
|
||||
}
|
||||
else return (c_w < d_w) ? u2_yes : u2_no;
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mb(Pt3, vor)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( (u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mbc(Pt3, vor)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt3, vor)[] = {
|
||||
{ ".2", c3__lite, j2_mb(Pt3, vor), Tier3, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,32 +0,0 @@
|
||||
/* j/4/by.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* declarations
|
||||
*/
|
||||
extern u2_ho_jet j2_mcj(Pt4, by, gas)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, by, get)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, by, has)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, by, int)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, by, put)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, by, uni)[];
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_driver
|
||||
j2_mbd(Pt4, by)[] = {
|
||||
{ j2_sc(Pt4, by, gas), j2_mcj(Pt4, by, gas), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, by, get), j2_mcj(Pt4, by, get), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, by, has), j2_mcj(Pt4, by, has), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, by, int), j2_mcj(Pt4, by, int), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, by, put), j2_mcj(Pt4, by, put), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, by, uni), j2_mcj(Pt4, by, uni), 0, 0, u2_none },
|
||||
{}
|
||||
};
|
||||
|
||||
u2_ho_driver
|
||||
j2_db(Pt4, by) =
|
||||
{ j2_sb(Pt4, by), 0, j2_mbd(Pt4, by), 0, u2_none };
|
||||
@ -1,63 +0,0 @@
|
||||
/* j/4/gas.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mcc(Pt4, by, gas)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == b ) {
|
||||
return u2_rx(wir_r, a);
|
||||
}
|
||||
else {
|
||||
if ( u2_no == u2_dust(b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
u2_noun i_b = u2_h(b);
|
||||
u2_noun t_b = u2_t(b);
|
||||
|
||||
if ( u2_no == u2_dust(i_b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
u2_noun pi_b = u2_h(i_b);
|
||||
u2_noun qi_b = u2_t(i_b);
|
||||
u2_noun c;
|
||||
|
||||
if ( u2_none == (c = j2_mcc(Pt4, by, put)(wir_r, a, pi_b, qi_b)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
u2_noun d = j2_mcc(Pt4, by, gas)(wir_r, c, t_b);
|
||||
|
||||
u2_rl_lose(wir_r, c);
|
||||
return d;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, by, gas)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, by, gas)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, by, gas)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, by, gas), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,59 +0,0 @@
|
||||
/* j/4/by_get.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_noun // transfer
|
||||
j2_mcc(Pt4, by, get)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_nul;
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a;
|
||||
u2_noun pn_a, qn_a;
|
||||
|
||||
if ( (u2_no == u2_as_trel(a, &n_a, &l_a, &r_a)) ||
|
||||
(u2_no == u2_as_cell(n_a, &pn_a, &qn_a) ) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
if ( (u2_yes == u2_sing(b, pn_a)) ) {
|
||||
return u2_rc(wir_r, u2_nul, u2_rx(wir_r, qn_a));
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == j2_mbc(Pt3, gor)(wir_r, b, pn_a) ) {
|
||||
return j2_mcc(Pt4, by, get)(wir_r, l_a, b);
|
||||
}
|
||||
else return j2_mcc(Pt4, by, get)(wir_r, r_a, b);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, by, get)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, by, get)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, by, get)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, by, get), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,59 +0,0 @@
|
||||
/* j/4/by_has.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_bean
|
||||
j2_mcc(Pt4, by, has)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_no;
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a;
|
||||
u2_noun pn_a, qn_a;
|
||||
|
||||
if ( (u2_no == u2_as_trel(a, &n_a, &l_a, &r_a)) ||
|
||||
(u2_no == u2_as_cell(n_a, &pn_a, &qn_a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
if ( (u2_yes == u2_sing(b, pn_a)) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == j2_mbc(Pt3, gor)(wir_r, b, pn_a) ) {
|
||||
return j2_mcc(Pt4, by, has)(wir_r, l_a, b);
|
||||
}
|
||||
else return j2_mcc(Pt4, by, has)(wir_r, r_a, b);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, by, has)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, by, has)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, by, has)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, by, has), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,135 +0,0 @@
|
||||
/* j/4/by_int.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mcc(Pt4, by, int)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_rx(wir_r, u2_nul);
|
||||
}
|
||||
else if ( u2_nul == b ) {
|
||||
return u2_rx(wir_r, u2_nul);
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a, lr_a, p_n_a, q_n_a;
|
||||
u2_noun l_b, n_b, r_b, lr_b, p_n_b, q_n_b;
|
||||
|
||||
if ( (u2_no == u2_as_cell(a, &n_a, &lr_a)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( (u2_no == u2_as_cell(b, &n_b, &lr_b)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_a, &l_a, &r_a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_b, &l_b, &r_b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(n_a, &p_n_a, &q_n_a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(n_b, &p_n_b, &q_n_b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, vor)(wir_r, p_n_a, p_n_b) ) {
|
||||
if ( u2_yes == u2_sing(p_n_a, p_n_b) ) {
|
||||
return u2_rt(
|
||||
wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
j2_mcc(Pt4, by, int)(wir_r, u2_rx(wir_r, l_a), u2_rx(wir_r, l_b)),
|
||||
j2_mcc(Pt4, by, int)(wir_r, u2_rx(wir_r, r_a), u2_rx(wir_r, r_b)));
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, p_n_b, p_n_a) ) {
|
||||
return j2_mcc(Pt4, by, uni)(
|
||||
wir_r,
|
||||
j2_mcc(Pt4, by, int)(wir_r,
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
u2_rx(wir_r, l_b),
|
||||
u2_rx(wir_r, u2_nul))),
|
||||
j2_mcc(Pt4, by, int)(wir_r,
|
||||
u2_rx(wir_r, a),
|
||||
u2_rx(wir_r, r_b)));
|
||||
}
|
||||
else {
|
||||
return j2_mcc(Pt4, by, uni)(
|
||||
wir_r,
|
||||
j2_mcc(Pt4, by, int)(wir_r,
|
||||
u2_rx(wir_r, r_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
u2_rx(wir_r, u2_nul),
|
||||
u2_rx(wir_r, r_b))),
|
||||
j2_mcc(Pt4, by, int)(wir_r,
|
||||
u2_rx(wir_r, a),
|
||||
u2_rx(wir_r, l_b)));
|
||||
}
|
||||
}
|
||||
else if ( u2_yes == u2_sing(p_n_b, p_n_a) ) {
|
||||
return u2_rt(
|
||||
wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
j2_mcc(Pt4, by, int)(wir_r, u2_rx(wir_r, l_b), u2_rx(wir_r, l_a)),
|
||||
j2_mcc(Pt4, by, int)(wir_r, u2_rx(wir_r, r_b), u2_rx(wir_r, r_a)));
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, p_n_a, p_n_b) ) {
|
||||
return j2_mcc(Pt4, by, uni)(
|
||||
wir_r,
|
||||
j2_mcc(Pt4, by, int)(wir_r,
|
||||
u2_rx(wir_r, l_b),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rx(wir_r, u2_nul))),
|
||||
j2_mcc(Pt4, by, int)(wir_r,
|
||||
u2_rx(wir_r, a),
|
||||
u2_rx(wir_r, r_a)));
|
||||
}
|
||||
else {
|
||||
return j2_mcc(Pt4, by, uni)(
|
||||
wir_r,
|
||||
j2_mcc(Pt4, by, int)(wir_r,
|
||||
u2_rx(wir_r, r_b),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, u2_nul),
|
||||
u2_rx(wir_r, r_a))),
|
||||
j2_mcc(Pt4, by, int)(wir_r,
|
||||
u2_rx(wir_r, a),
|
||||
u2_rx(wir_r, l_a)));
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, by, int)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, by, int)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, by, int)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, by, int), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
|
||||
|
||||
@ -1,115 +0,0 @@
|
||||
/* j/4/put.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mcc(Pt4, by, put)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b, // retain
|
||||
u2_noun c) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_rt(wir_r,
|
||||
u2_rc(wir_r, u2_rx(wir_r, b),
|
||||
u2_rx(wir_r, c)),
|
||||
u2_nul,
|
||||
u2_nul);
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a, pn_a, qn_a;
|
||||
u2_noun d, l_d, n_d, r_d;
|
||||
|
||||
if ( (u2_no == u2_as_trel(a, &n_a, &l_a, &r_a)) ||
|
||||
(u2_no == u2_as_cell(n_a, &pn_a, &qn_a)) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_yes == u2_sing(pn_a, b) ) {
|
||||
if ( u2_yes == u2_sing(qn_a, c) ) {
|
||||
return u2_rx(wir_r, a);
|
||||
} else {
|
||||
return u2_rt
|
||||
(wir_r, u2_rc(wir_r, u2_rx(wir_r, b), u2_rx(wir_r, c)),
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rx(wir_r, r_a));
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == j2_mbc(Pt3, gor)(wir_r, b, pn_a) ) {
|
||||
d = j2_mcc(Pt4, by, put)(wir_r, l_a, b, c);
|
||||
|
||||
if ( u2_yes == j2_mbc(Pt3, vor)(wir_r, pn_a, u2_h(u2_h(d))) ) {
|
||||
return u2_rt(wir_r, u2_rx(wir_r, n_a),
|
||||
d,
|
||||
u2_rx(wir_r, r_a));
|
||||
}
|
||||
else {
|
||||
u2_as_trel(d, &n_d, &l_d, &r_d);
|
||||
{
|
||||
u2_noun e = u2_rt
|
||||
(wir_r, u2_rx(wir_r, n_d),
|
||||
u2_rx(wir_r, l_d),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, r_d),
|
||||
u2_rx(wir_r, r_a)));
|
||||
|
||||
u2_rl_lose(wir_r, d);
|
||||
return e;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
d = j2_mcc(Pt4, by, put)(wir_r, r_a, b, c);
|
||||
|
||||
if ( u2_yes == j2_mbc(Pt3, vor)(wir_r, pn_a, u2_h(u2_h(d))) ) {
|
||||
return u2_rt(wir_r, u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, l_a),
|
||||
d);
|
||||
}
|
||||
else {
|
||||
u2_as_trel(d, &n_d, &l_d, &r_d);
|
||||
{
|
||||
u2_noun e = u2_rt
|
||||
(wir_r, u2_rx(wir_r, n_d),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rx(wir_r, l_d)),
|
||||
u2_rx(wir_r, r_d));
|
||||
|
||||
u2_rl_lose(wir_r, d);
|
||||
return e;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, by, put)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b, c;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &b,
|
||||
u2_cv_sam_3, &c,
|
||||
u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, by, put)(wir_r, a, b, c);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, by, put)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, by, put), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,137 +0,0 @@
|
||||
/* j/4/by_uni.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mcc(Pt4, by, uni)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_rx(wir_r, b);
|
||||
}
|
||||
else if ( u2_nul == b ) {
|
||||
return u2_rx(wir_r, a);
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a, lr_a, p_n_a, q_n_a;
|
||||
u2_noun l_b, n_b, r_b, lr_b, p_n_b, q_n_b;
|
||||
|
||||
if ( (u2_no == u2_as_cell(a, &n_a, &lr_a)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( (u2_no == u2_as_cell(b, &n_b, &lr_b)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( (u2_no == u2_as_cell(n_a, &p_n_a, &q_n_a)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( (u2_no == u2_as_cell(n_b, &p_n_b, &q_n_b)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_a, &l_a, &r_a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_b, &l_b, &r_b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, vor)(wir_r, p_n_a, p_n_b) ) {
|
||||
if ( u2_yes == u2_sing(p_n_a, p_n_b) ) {
|
||||
return u2_rt(wir_r, u2_rx(wir_r, n_b),
|
||||
j2_mcc(Pt4, by, uni)(
|
||||
wir_r, u2_rx(wir_r, l_a), u2_rx(wir_r, l_b)),
|
||||
j2_mcc(Pt4, by, uni)(
|
||||
wir_r, u2_rx(wir_r, r_a), u2_rx(wir_r, r_b)));
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, p_n_b, p_n_a) ) {
|
||||
return j2_mcc(Pt4, by, uni)(
|
||||
wir_r,
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
j2_mcc(Pt4, by, uni)(wir_r,
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
u2_rx(wir_r, l_b),
|
||||
u2_rx(wir_r, u2_nul))),
|
||||
u2_rx(wir_r, r_a)),
|
||||
u2_rx(wir_r, r_b));
|
||||
}
|
||||
else {
|
||||
return j2_mcc(Pt4, by, uni)(
|
||||
wir_r,
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, l_a),
|
||||
j2_mcc(Pt4, by, uni)(wir_r,
|
||||
u2_rx(wir_r, r_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
u2_rx(wir_r, u2_nul),
|
||||
u2_rx(wir_r, r_b)))),
|
||||
u2_rx(wir_r, l_b));
|
||||
}
|
||||
}
|
||||
else if ( u2_yes == u2_sing(p_n_b, p_n_a) ) {
|
||||
return u2_rt(
|
||||
wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
j2_mcc(Pt4, by, uni)(wir_r, u2_rx(wir_r, r_b), u2_rx(wir_r, r_a)),
|
||||
j2_mcc(Pt4, by, uni)(wir_r, u2_rx(wir_r, l_b), u2_rx(wir_r, l_a)));
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, p_n_a, p_n_b) ) {
|
||||
return j2_mcc(Pt4, by, uni)(
|
||||
wir_r,
|
||||
u2_rx(wir_r, r_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
j2_mcc(Pt4, by, uni)(wir_r,
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rx(wir_r, u2_nul)),
|
||||
u2_rx(wir_r, l_b)),
|
||||
u2_rx(wir_r, r_b)));
|
||||
}
|
||||
else {
|
||||
return j2_mcc(Pt4, by, uni)(
|
||||
wir_r,
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
u2_rx(wir_r, l_b),
|
||||
j2_mcc(Pt4, by, uni)(wir_r,
|
||||
u2_rx(wir_r, r_b),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, u2_nul),
|
||||
u2_rx(wir_r, r_a)))));
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, by, uni)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, by, uni)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, by, uni)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, by, uni), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
@ -1,39 +0,0 @@
|
||||
/* j/4/in.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* declarations
|
||||
*/
|
||||
extern u2_ho_jet j2_mcj(Pt4, in, gas)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, in, has)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, in, mer)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, in, int)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, in, put)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, in, tap)[];
|
||||
extern u2_ho_jet j2_mcj(Pt4, in, uni)[];
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_driver
|
||||
j2_mbd(Pt4, in)[] = {
|
||||
{ j2_sc(Pt4, in, gas), j2_mcj(Pt4, in, gas), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, in, has), j2_mcj(Pt4, in, has), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, in, mer), j2_mcj(Pt4, in, mer), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, in, int), j2_mcj(Pt4, in, int), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, in, put), j2_mcj(Pt4, in, put), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, in, tap), j2_mcj(Pt4, in, tap), 0, 0, u2_none },
|
||||
{ j2_sc(Pt4, in, uni), j2_mcj(Pt4, in, uni), 0, 0, u2_none },
|
||||
{}
|
||||
};
|
||||
|
||||
u2_ho_jet
|
||||
j2_mbj(Pt4, in)[] = {
|
||||
{ }
|
||||
};
|
||||
|
||||
u2_ho_driver
|
||||
j2_db(Pt4, in) =
|
||||
{ j2_sb(Pt4, in), j2_mbj(Pt4, in), j2_mbd(Pt4, in), 0, u2_none };
|
||||
@ -1,56 +0,0 @@
|
||||
/* j/4/gas.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mcc(Pt4, in, gas)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == b ) {
|
||||
return u2_rx(wir_r, a);
|
||||
}
|
||||
else {
|
||||
if ( u2_no == u2_dust(b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
u2_noun i_b = u2_h(b);
|
||||
u2_noun t_b = u2_t(b);
|
||||
u2_noun c;
|
||||
|
||||
if ( u2_none == (c = j2_mcc(Pt4, in, put)(wir_r, a, i_b)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
u2_noun d = j2_mcc(Pt4, in, gas)(wir_r, c, t_b);
|
||||
|
||||
u2_rl_lose(wir_r, c);
|
||||
return d;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, in, gas)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, in, gas)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, in, gas)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, in, gas), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,56 +0,0 @@
|
||||
/* j/4/in_has.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_bean
|
||||
j2_mcc(Pt4, in, has)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_no;
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a;
|
||||
|
||||
if ( (u2_no == u2_mean(a, 2, &n_a, 6, &l_a, 7, &r_a, 0)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
if ( (u2_yes == u2_sing(b, n_a)) ) {
|
||||
return u2_yes;
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, b, n_a) ) {
|
||||
return j2_mcc(Pt4, in, has)(wir_r, l_a, b);
|
||||
}
|
||||
else return j2_mcc(Pt4, in, has)(wir_r, r_a, b);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, in, has)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, in, has)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, in, has)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, in, has), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,97 +0,0 @@
|
||||
/* j/4/in_int.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mcc(Pt4, in, int)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_rx(wir_r, u2_nul);
|
||||
}
|
||||
else if ( u2_nul == b ) {
|
||||
return u2_rx(wir_r, u2_nul);
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a, lr_a;
|
||||
u2_noun l_b, n_b, r_b, lr_b;
|
||||
u2_noun c;
|
||||
|
||||
if ( (u2_no == u2_as_cell(a, &n_a, &lr_a)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( (u2_no == u2_as_cell(b, &n_b, &lr_b)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == j2_mbc(Pt3, vor)(wir_r, n_b, n_a) ) {
|
||||
c = a; a = b; b = c;
|
||||
c = n_a; n_a = n_b; n_b = c;
|
||||
c = lr_a; lr_a = lr_b; lr_b = c;
|
||||
}
|
||||
if ( u2_no == u2_as_cell(lr_a, &l_a, &r_a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_b, &l_b, &r_b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_yes == u2_sing(n_a, n_b) ) {
|
||||
return u2_rt(wir_r, u2_rx(wir_r, n_a),
|
||||
j2_mcc(Pt4, in, int)(wir_r, l_a, l_b),
|
||||
j2_mcc(Pt4, in, int)(wir_r, r_a, r_b));
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, n_b, n_a) ) {
|
||||
return j2_mcc(Pt4, in, uni)(wir_r,
|
||||
j2_mcc(Pt4, in, int)(wir_r,
|
||||
l_a,
|
||||
u2_rt(wir_r,
|
||||
n_b,
|
||||
l_b,
|
||||
u2_nul)),
|
||||
j2_mcc(Pt4, in, int)(wir_r,
|
||||
a,
|
||||
r_b));
|
||||
}
|
||||
else {
|
||||
return j2_mcc(Pt4, in, uni)(wir_r,
|
||||
j2_mcc(Pt4, in, int)(wir_r,
|
||||
r_a,
|
||||
u2_rt(wir_r,
|
||||
n_b,
|
||||
u2_nul,
|
||||
r_b)),
|
||||
j2_mcc(Pt4, in, int)(wir_r,
|
||||
a,
|
||||
l_b));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, in, int)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, in, int)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, in, int)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, in, int), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
|
||||
@ -1,98 +0,0 @@
|
||||
/* j/4/in_mer.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mcc(Pt4, in, mer)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_rx(wir_r, b);
|
||||
}
|
||||
else if ( u2_nul == b ) {
|
||||
return u2_rx(wir_r, a);
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a, lr_a; // XX copy tree boilerplate to other pt4
|
||||
u2_noun l_b, n_b, r_b, lr_b;
|
||||
u2_noun c;
|
||||
|
||||
if ( (u2_no == u2_as_cell(a, &n_a, &lr_a)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( (u2_no == u2_as_cell(b, &n_b, &lr_b)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == j2_mbc(Pt3, vor)(wir_r, n_b, n_a) ) {
|
||||
c = a; a = b; b = c;
|
||||
c = n_a; n_a = n_b; n_b = c;
|
||||
c = lr_a; lr_a = lr_b; lr_b = c;
|
||||
}
|
||||
if ( u2_no == u2_as_cell(lr_a, &l_a, &r_a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_b, &l_b, &r_b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_yes == u2_sing(n_a, n_b) ) {
|
||||
return u2_rt(wir_r, u2_rx(wir_r, n_a),
|
||||
j2_mcc(Pt4, in, mer)(wir_r, l_a, l_b),
|
||||
j2_mcc(Pt4, in, mer)(wir_r, r_a, r_b));
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, n_b, n_a) ) {
|
||||
return j2_mcc(Pt4, in, mer)(wir_r,
|
||||
u2_rt(wir_r,
|
||||
n_a,
|
||||
j2_mcc(Pt4, in, mer)(wir_r,
|
||||
l_a,
|
||||
u2_rt(wir_r,
|
||||
n_b,
|
||||
l_b,
|
||||
u2_nul)),
|
||||
r_a),
|
||||
r_b);
|
||||
}
|
||||
else {
|
||||
return j2_mcc(Pt4, in, mer)(wir_r,
|
||||
u2_rt(wir_r,
|
||||
n_a,
|
||||
l_a,
|
||||
j2_mcc(Pt4, in, mer)(wir_r,
|
||||
r_a,
|
||||
u2_rt(wir_r,
|
||||
n_b,
|
||||
u2_nul,
|
||||
r_b))),
|
||||
l_b);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, in, mer)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, in, mer)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, in, mer)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, in, mer), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
@ -1,102 +0,0 @@
|
||||
/* j/4/in_put.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mcc(Pt4, in, put)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_rt(wir_r, u2_rx(wir_r, b), u2_nul, u2_nul);
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a, lr_a; // XX copy tree boilerplate to other pt4
|
||||
u2_noun c, l_c, n_c, r_c;
|
||||
|
||||
if ( (u2_no == u2_as_cell(a, &n_a, &lr_a)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_yes == u2_sing(n_a, b) ) {
|
||||
return u2_rx(wir_r, a);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_a, &l_a, &r_a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, b, n_a) ) {
|
||||
c = j2_mcc(Pt4, in, put)(wir_r, l_a, b);
|
||||
|
||||
if ( u2_yes == j2_mbc(Pt3, vor)(wir_r, n_a, u2_h(c)) ) {
|
||||
return u2_rt(wir_r, u2_rx(wir_r, n_a),
|
||||
c,
|
||||
u2_rx(wir_r, r_a));
|
||||
}
|
||||
else {
|
||||
u2_as_trel(c, &n_c, &l_c, &r_c);
|
||||
{
|
||||
u2_noun d = u2_rt
|
||||
(wir_r, u2_rx(wir_r, n_c),
|
||||
u2_rx(wir_r, l_c),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, r_c),
|
||||
u2_rx(wir_r, r_a)));
|
||||
|
||||
u2_rl_lose(wir_r, c);
|
||||
return d;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
c = j2_mcc(Pt4, in, put)(wir_r, r_a, b);
|
||||
|
||||
if ( u2_yes == j2_mbc(Pt3, vor)(wir_r, n_a, u2_h(c)) ) {
|
||||
return u2_rt(wir_r, u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, l_a),
|
||||
c);
|
||||
}
|
||||
else {
|
||||
u2_as_trel(c, &n_c, &l_c, &r_c);
|
||||
{
|
||||
u2_noun d = u2_rt
|
||||
(wir_r, u2_rx(wir_r, n_c),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rx(wir_r, l_c)),
|
||||
u2_rx(wir_r, r_c));
|
||||
|
||||
u2_rl_lose(wir_r, c);
|
||||
return d;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, in, put)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, in, put)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, in, put)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, in, put), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,58 +0,0 @@
|
||||
/* j/4/in_tap.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
static u2_weak // produce
|
||||
_tap_in(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // submit
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return b;
|
||||
} else {
|
||||
u2_noun l_a, n_a, r_a;
|
||||
|
||||
if ( (u2_no == u2_as_trel(a, &n_a, &l_a, &r_a)) ) {
|
||||
u2_rz(wir_r, b);
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return _tap_in
|
||||
(wir_r, r_a,
|
||||
u2_rc(wir_r, u2_rx(wir_r, n_a),
|
||||
_tap_in(wir_r, l_a, b)));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
u2_weak // produce
|
||||
j2_mcc(Pt4, in, tap)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
return _tap_in(wir_r, a, u2_rx(wir_r, b));
|
||||
}
|
||||
u2_weak // produce
|
||||
j2_mc(Pt4, in, tap)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, in, tap)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, in, tap)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, in, tap), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,139 +0,0 @@
|
||||
/* j/4/in_uni.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak // transfer
|
||||
j2_mcc(Pt4, in, uni)(u2_wire wir_r,
|
||||
u2_noun a, // retain
|
||||
u2_noun b) // retain
|
||||
{
|
||||
if ( u2_nul == a ) {
|
||||
return u2_rx(wir_r, b);
|
||||
}
|
||||
else if ( u2_nul == b ) {
|
||||
return u2_rx(wir_r, a);
|
||||
}
|
||||
else {
|
||||
u2_noun l_a, n_a, r_a, lr_a;
|
||||
u2_noun l_b, n_b, r_b, lr_b;
|
||||
|
||||
if ( (u2_no == u2_as_cell(a, &n_a, &lr_a)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( (u2_no == u2_as_cell(b, &n_b, &lr_b)) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
if ( u2_yes == j2_mbc(Pt3, vor)(wir_r, n_a, n_b) ) {
|
||||
if ( u2_no == u2_as_cell(lr_a, &l_a, &r_a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_b, &l_b, &r_b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_yes == u2_sing(n_a, n_b) ) {
|
||||
return u2_rt(
|
||||
wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
j2_mcc(Pt4, in, uni)(wir_r, u2_rx(wir_r, l_a), u2_rx(wir_r, l_b)),
|
||||
j2_mcc(Pt4, in, uni)(wir_r, u2_rx(wir_r, r_a), u2_rx(wir_r, r_b)));
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, n_b, n_a) ) {
|
||||
return j2_mcc(Pt4, in, uni)(
|
||||
wir_r,
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
j2_mcc(Pt4, in, uni)(wir_r,
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
u2_rx(wir_r, l_b),
|
||||
u2_rx(wir_r, u2_nul))),
|
||||
u2_rx(wir_r, r_a)),
|
||||
u2_rx(wir_r, r_b));
|
||||
}
|
||||
else {
|
||||
return j2_mcc(Pt4, in, uni)(
|
||||
wir_r,
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, l_a),
|
||||
j2_mcc(Pt4, in, uni)(wir_r,
|
||||
u2_rx(wir_r, r_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
u2_rx(wir_r, u2_nul),
|
||||
u2_rx(wir_r, r_b)))),
|
||||
u2_rx(wir_r, l_b));
|
||||
}
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_b, &l_b, &r_b) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_no == u2_as_cell(lr_a, &l_a, &r_a) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else if ( u2_yes == u2_sing(n_b, n_a) ) {
|
||||
return u2_rt(
|
||||
wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
j2_mcc(Pt4, in, uni)(wir_r, u2_rx(wir_r, r_b), u2_rx(wir_r, r_a)),
|
||||
j2_mcc(Pt4, in, uni)(wir_r, u2_rx(wir_r, l_b), u2_rx(wir_r, l_a)));
|
||||
}
|
||||
else if ( u2_yes == j2_mbc(Pt3, hor)(wir_r, n_a, n_b) ) {
|
||||
return j2_mcc(Pt4, in, uni)(
|
||||
wir_r,
|
||||
u2_rx(wir_r, r_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
j2_mcc(Pt4, in, uni)(wir_r,
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_nul),
|
||||
u2_rx(wir_r, l_b)),
|
||||
u2_rx(wir_r, r_b)));
|
||||
}
|
||||
else {
|
||||
return j2_mcc(Pt4, in, uni)(
|
||||
wir_r,
|
||||
u2_rx(wir_r, l_a),
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_b),
|
||||
u2_rx(wir_r, l_b),
|
||||
j2_mcc(Pt4, in, uni)(wir_r,
|
||||
u2_rt(wir_r,
|
||||
u2_rx(wir_r, n_a),
|
||||
u2_rx(wir_r, u2_nul),
|
||||
u2_rx(wir_r, r_a)),
|
||||
u2_rx(wir_r, r_b))));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
u2_weak // transfer
|
||||
j2_mc(Pt4, in, uni)(u2_wire wir_r,
|
||||
u2_noun cor) // retain
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam, &b, u2_cv_con_sam, &a, 0) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
} else {
|
||||
return j2_mcc(Pt4, in, uni)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt4, in, uni)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt4, in, uni), Tier4, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
155
gen164/5/aesc.c
155
gen164/5/aesc.c
@ -1,155 +0,0 @@
|
||||
/* j/5/aes.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
#if defined(U2_OS_osx)
|
||||
#include <CommonCrypto/CommonCryptor.h>
|
||||
#else
|
||||
#include <openssl/aes.h>
|
||||
#endif
|
||||
|
||||
/* declarations
|
||||
*/
|
||||
extern u2_ho_jet j2_mcj(Pt5, aesc, en)[];
|
||||
extern u2_ho_jet j2_mcj(Pt5, aesc, de)[];
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak
|
||||
j2_mcd(Pt5, aesc, en)(u2_wire wir_r,
|
||||
u2_atom a,
|
||||
u2_atom b)
|
||||
{
|
||||
c3_y a_y[32];
|
||||
c3_y b_y[16];
|
||||
#if defined(U2_OS_osx)
|
||||
size_t siz_i = 0;
|
||||
#else
|
||||
AES_KEY key_u;
|
||||
#endif
|
||||
|
||||
c3_assert(u2_cr_met(3, a) <= 32);
|
||||
c3_assert(u2_cr_met(3, b) <= 16);
|
||||
|
||||
u2_cr_bytes(0, 32, a_y, a);
|
||||
u2_cr_bytes(0, 16, b_y, b);
|
||||
|
||||
#if defined(U2_OS_osx)
|
||||
if ( kCCSuccess != CCCrypt(kCCEncrypt, kCCAlgorithmAES128,
|
||||
kCCOptionECBMode, a_y, kCCKeySizeAES256, 0, b_y,
|
||||
16, b_y, 16, &siz_i) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else c3_assert(16 == siz_i);
|
||||
#else
|
||||
if ( 0 != AES_set_encrypt_key(a_y, 256, &key_u) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
AES_encrypt(b_y, b_y, &key_u);
|
||||
}
|
||||
#endif
|
||||
|
||||
return u2_ci_bytes(16, b_y);
|
||||
}
|
||||
|
||||
u2_weak
|
||||
j2_mc(Pt5, aesc, en)(u2_wire wir_r,
|
||||
u2_noun cor)
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ||
|
||||
u2_no == u2_stud(a) ||
|
||||
u2_no == u2_stud(b) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
return j2_mcd(Pt5, aesc, en)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
u2_weak
|
||||
j2_mcd(Pt5, aesc, de)(u2_wire wir_r,
|
||||
u2_atom a,
|
||||
u2_atom b)
|
||||
{
|
||||
c3_y a_y[32];
|
||||
c3_y b_y[16];
|
||||
#if defined(U2_OS_osx)
|
||||
size_t siz_i = 0;
|
||||
#else
|
||||
AES_KEY key_u;
|
||||
#endif
|
||||
|
||||
c3_assert(u2_cr_met(3, a) <= 32);
|
||||
c3_assert(u2_cr_met(3, b) <= 16);
|
||||
|
||||
u2_cr_bytes(0, 32, a_y, a);
|
||||
u2_cr_bytes(0, 16, b_y, b);
|
||||
|
||||
#if defined(U2_OS_osx)
|
||||
if ( kCCSuccess != CCCrypt(kCCDecrypt, kCCAlgorithmAES128,
|
||||
kCCOptionECBMode, a_y, kCCKeySizeAES256, 0, b_y,
|
||||
16, b_y, 16, &siz_i) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else c3_assert(16 == siz_i);
|
||||
#else
|
||||
if ( 0 != AES_set_decrypt_key(a_y, 256, &key_u) ) {
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
AES_decrypt(b_y, b_y, &key_u);
|
||||
}
|
||||
#endif
|
||||
|
||||
return u2_ci_bytes(16, b_y);
|
||||
}
|
||||
|
||||
u2_weak
|
||||
j2_mc(Pt5, aesc, de)(u2_wire wir_r,
|
||||
u2_noun cor)
|
||||
{
|
||||
u2_noun a, b;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_2, &a, u2_cv_sam_3, &b, 0) ||
|
||||
u2_no == u2_stud(a) ||
|
||||
u2_no == u2_stud(b) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
else {
|
||||
return j2_mcd(Pt5, aesc, de)(wir_r, a, b);
|
||||
}
|
||||
}
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt5, aesc, en)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt5, aesc, en), Tier5, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
u2_ho_jet
|
||||
j2_mcj(Pt5, aesc, de)[] = {
|
||||
{ ".2", c3__lite, j2_mc(Pt5, aesc, de), Tier5, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
u2_ho_driver
|
||||
j2_mbd(Pt5, aesc)[] = {
|
||||
{ j2_sc(Pt5, aesc, en), j2_mcj(Pt5, aesc, en), 0, 0, u2_none },
|
||||
{ j2_sc(Pt5, aesc, de), j2_mcj(Pt5, aesc, de), 0, 0, u2_none },
|
||||
{ }
|
||||
};
|
||||
|
||||
u2_ho_driver
|
||||
j2_db(Pt5, aesc) =
|
||||
{ j2_sb(Pt5, aesc), 0, j2_mbd(Pt5, aesc), 0, u2_none };
|
||||
@ -1,28 +0,0 @@
|
||||
/* gen164/5/co.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
/* declarations
|
||||
*/
|
||||
extern u2_ho_jet j2_mdj(Pt5, coco, co, emco)[];
|
||||
extern u2_ho_jet j2_mdj(Pt5, coco, co, oxco)[];
|
||||
extern u2_ho_jet j2_mdj(Pt5, coco, co, roco)[];
|
||||
|
||||
u2_ho_driver
|
||||
j2_mcd(Pt5, coco, co)[] = {
|
||||
{ j2_sd(Pt5, coco, co, emco), j2_mdj(Pt5, coco, co, emco), 0, 0, u2_none },
|
||||
{ j2_sd(Pt5, coco, co, oxco), j2_mdj(Pt5, coco, co, oxco), 0, 0, u2_none },
|
||||
{ j2_sd(Pt5, coco, co, roco), j2_mdj(Pt5, coco, co, roco), 0, 0, u2_none },
|
||||
{}
|
||||
};
|
||||
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_driver
|
||||
j2_mbd(Pt5, coco)[] = {
|
||||
{ j2_sc(Pt5, coco, co), 0, j2_mcd(Pt5, coco, co), 0, u2_none },
|
||||
{}
|
||||
};
|
||||
@ -1,61 +0,0 @@
|
||||
/* gen164/5/co_emco.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
|
||||
/* functions
|
||||
*/
|
||||
|
||||
/* parameters
|
||||
[[bas=@ min=@] [par=$+([? @ tape] tape)]]
|
||||
*/
|
||||
|
||||
u2_weak
|
||||
j2_md(Pt5, coco, co, emco)(u2_wire wir_r,
|
||||
u2_noun cor)
|
||||
{
|
||||
u2_atom bas, min;
|
||||
u2_noun rex;
|
||||
u2_noun par;
|
||||
u2_atom hol = 0;
|
||||
mpz_t bas_mp, dar_mp, hol_mp, rad_mp;
|
||||
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_4, &bas,
|
||||
u2_cv_sam_5, &min,
|
||||
u2_cv_sam_3, &par,
|
||||
u2_cv_sam_6, &rex,
|
||||
0) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
|
||||
while ( 1 ) {
|
||||
if ( !hol && !min ) {
|
||||
return rex;
|
||||
}
|
||||
|
||||
u2_mp(bas_mp, bas);
|
||||
u2_mp(hol_mp, hol);
|
||||
|
||||
mpz_tdiv_q(rad_mp, hol_mp, bas_mp);
|
||||
mpz_tdiv_r(dar_mp, hol_mp, bas_mp);
|
||||
|
||||
if ( min ) {
|
||||
min--;
|
||||
}
|
||||
|
||||
u2_rl_mp(hol, dar_mp);
|
||||
|
||||
// rex (par =(0 dar) rad rex)
|
||||
}
|
||||
}
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mdj(Pt5, coco, co, emco)[] = {
|
||||
{ ".2", c3__lite, j2_md(Pt5, coco, co, emco), u2_jet_dead, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
@ -1,33 +0,0 @@
|
||||
/* gen164/5/co_oxco.c
|
||||
**
|
||||
** This file is in the public domain.
|
||||
*/
|
||||
#include "all.h"
|
||||
#include "../pit.h"
|
||||
|
||||
|
||||
/* functions
|
||||
*/
|
||||
u2_weak
|
||||
j2_md(Pt5, coco, co, oxco)(u2_wire wir_r,
|
||||
u2_noun cor)
|
||||
{
|
||||
u2_atom bas, gop;
|
||||
u2_noun dug;
|
||||
if ( u2_no == u2_mean(cor, u2_cv_sam_4, &bas,
|
||||
u2_cv_sam_5, &gop,
|
||||
u2_cv_sam_3, &dug,
|
||||
0) )
|
||||
{
|
||||
return u2_bl_bail(wir_r, c3__exit);
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
/* structures
|
||||
*/
|
||||
u2_ho_jet
|
||||
j2_mdj(Pt5, coco, co, oxco)[] = {
|
||||
{ ".2", c3__lite, j2_md(Pt5, coco, co, oxco), u2_jet_dead, u2_none, u2_none },
|
||||
{ }
|
||||
};
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user