ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-11-09 22:54:53 +03:00
Code Issues Packages Projects Releases Wiki Activity

Various fixes and improvements.

Browse Source
This commit is contained in:
C. Guy Yarvin 2014-08-25 02:58:38 -04:00
parent c0326a0c06
commit 66bd19ed0a
15 changed files with 303 additions and 283 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Makefile
View File

@ -57,7 +57,7 @@ endif
INCLUDE=include
MDEFINES=-DU2_OS_$(OS) -DU2_OS_ENDIAN_$(ENDIAN) -D U2_LIB=\"$(LIB)\"
CFLAGS= -O3 -msse3 -ffast-math \
CFLAGS= -g -msse3 -ffast-math \
-funsigned-char \
-I/usr/local/include \
-I/opt/local/include \
@ -317,7 +317,7 @@ $(LIBANACHRONISM):
$(MAKE) -C outside/anachronism static
$(BPT_O): outside/bpt/bitmapped_patricia_tree.c
$(CC) -O2 -o $@ -c $<
$(CC) -g -o $@ -c $<
$(CRE2_OFILES): outside/cre2/src/src/cre2.cpp outside/cre2/src/src/cre2.h $(LIBRE2)
$(CXX) $(CXXFLAGS) -c $< $(LIBRE2) -o $@
@ -330,7 +330,7 @@ $(BIN)/vere: $(LIBCRE) $(VERE_OFILES) $(LIBUV) $(LIBRE2) $(LIBED25519) $(BPT_O)
meme: $(BIN)/meme
MEME_OFILES=f/meme.o $(BPT_O) f/nash.o \
MEME_OFILES=f/meme.o $(BPT_O) f/nash.o f/pork.o \
gen164/1/add.o \
gen164/1/dec.o \
gen164/1/gth.o \
@ -350,7 +350,7 @@ MEME_OFILES=f/meme.o $(BPT_O) f/nash.o \
gen164/5/jam.o
$(BIN)/meme: $(MEME_OFILES)
$(CLD) $(CLDOSFLAGS) -o $(BIN)/meme $(MEME_OFILES) -lgmp
$(CLD) -g $(CLDOSFLAGS) -o $(BIN)/meme $(MEME_OFILES) -lgmp
tags:
ctags -R -f .tags --exclude=root

149
f/meme.c
View File

@ -22,6 +22,7 @@
#include <errno.h>
#include "f/meme.h"
#include "f/pork.h"
#include "../gen164/pit.h"
/** Jet dependencies. Minimize these.
@ -198,9 +199,25 @@ _road_dump(void)
}
printf("dump: hat_w %x, fre_w %x, allocated %x\n",
hat_w, fre_w, (hat_w - fre_w));
if ( 0 != (hat_w - fre_w) ) {
c3_w* box_w = u2R->rut_w;
c3_w mem_w = 0;
while ( box_w < u2R->hat_w ) {
u2_cs_box* box_u = (void *)box_w;
if ( 0 != box_u->use_w ) {
mem_w += box_u->siz_w;
}
box_w += box_u->siz_w;
}
printf("second count: %x\n", mem_w);
}
}
#if 0
#if 1
static void
_road_sane(void)
{
@ -507,35 +524,28 @@ u2_ca_walloc(c3_w len_w)
}
}
int MALLOC=0;
int REALLOC=0;
/* u2_ca_malloc(): allocate storage measured in bytes.
*/
void*
u2_ca_malloc(c3_w len_w)
{
MALLOC++;
return u2_ca_walloc((len_w + 3) >> 2);
}
/* u2_ca_realloc(): crude realloc.
/* u2_ca_wealloc(): realloc in words.
*/
void*
u2_ca_realloc(void* lag_v, c3_w len_w)
u2_ca_wealloc(void* lag_v, c3_w len_w)
{
REALLOC++;
if ( !lag_v ) {
return u2_ca_malloc(len_w);
}
else {
u2_cs_box* box_u = u2_co_botox(lag_v);
c3_w* old_w = lag_v;
c3_w niz_w = (len_w + 3) >> 2;
c3_w tiz_w = c3_min(box_u->siz_w, niz_w);
c3_w tiz_w = c3_min(box_u->siz_w, len_w);
{
c3_w* new_w = u2_ca_walloc(niz_w);
c3_w* new_w = u2_ca_walloc(len_w);
c3_w i_w;
for ( i_w = 0; i_w < tiz_w; i_w++ ) {
@ -547,6 +557,14 @@ u2_ca_realloc(void* lag_v, c3_w len_w)
}
}
/* u2_ca_realloc(): realloc in bytes.
*/
void*
u2_ca_realloc(void* lag_v, c3_w len_w)
{
return u2_ca_wealloc(lag_v, (len_w + 3) >> 2);
}
/* u2_ca_free(): free storage.
*/
void
@ -2226,8 +2244,8 @@ _sing_x(u2_noun a,
return u2_no;
}
else {
u2_cs_atom* a_u = u2_co_to_ptr(a);
u2_cs_atom* b_u = u2_co_to_ptr(b);
u2_cs_cell* a_u = u2_co_to_ptr(a);
u2_cs_cell* b_u = u2_co_to_ptr(b);
if ( a_u->mug_w &&
b_u->mug_w &&
@ -3430,13 +3448,14 @@ _depth(u2_noun som)
// Wordy.
int
#if 0
static int
_bits_word(c3_w w)
{
return w ? (32 - __builtin_clz(w)) : 0;
}
void
static void
_test_words(void)
{
c3_w i_w = 0;
@ -3453,24 +3472,11 @@ _test_words(void)
i_w++;
}
}
// A simple memory tester.
//
int c3_cooked() { u2_cm_bail(c3__oops); return 0; }
int
main(int argc, char *argv[])
{
printf("hello, world: len %dMB\n", (1 << U2_OS_LoomBits) >> 18);
_test_words();
u2_cm_boot(U2_OS_LoomBase, (1 << U2_OS_LoomBits));
printf("booted.\n");
#if 0
_road_dump();
test();
_road_dump();
#endif
static void
_test_jam(void)
{
_road_dump();
{
u2_noun pil = u2_walk_load("urb/urbit.pill");
@ -3480,12 +3486,87 @@ main(int argc, char *argv[])
cue = u2_cke_cue(pil);
printf("cued - mug %x\n", u2_cr_mug(cue));
#if 1
jam = u2_cke_jam(cue);
printf("jammed - %d bytes\n", u2_cr_met(3, jam));
cue = u2_cke_cue(jam);
printf("cued - mug %x\n", u2_cr_mug(cue));
#endif
u2z(cue);
}
_road_dump();
printf("MALLOC %d, REALLOC %d\n", MALLOC, REALLOC);
}
static void
_test_hash_bad(void)
{
_road_dump();
{
u2_ha_root* har_u = u2_ha_new();
c3_w i_w;
c3_w max_w = (1 << 20);
for ( i_w = 0; i_w < max_w; i_w++ ) {
u2_ha_put(har_u, u2nc(0, i_w), u2nc(0, (i_w + 1)));
}
for ( i_w = 0; i_w < max_w; i_w++ ) {
u2_noun val = u2_ha_get(har_u, u2nc(0, i_w));
if ( u2_none == val ) {
printf("at %d, nothing\n", i_w);
c3_assert(0);
}
if ( (u2h(val) != 0) || (u2t(val) != (i_w + 1)) ) {
printf("at %d, oddly, is %d\n", i_w, val);
c3_assert(0);
}
u2_ca_lose(val);
}
u2_ha_free(har_u);
}
_road_dump();
}
static void
_test_hash(void)
{
_road_dump();
{
u2_ha_root* har_u = u2_ha_new();
c3_w i_w;
c3_w max_w = (1 << 20);
for ( i_w = 0; i_w < max_w; i_w++ ) {
u2_ha_put(har_u, u2nc(0, i_w), (i_w + 1));
}
for ( i_w = 0; i_w < max_w; i_w++ ) {
u2_noun val = u2_ha_get(har_u, u2nc(0, i_w));
if ( val != (i_w + 1) ) {
if ( u2_none == val ) {
printf("at %d, nothing\n", i_w);
}
else printf("at %d, oddly, is %d\n", i_w, val);
c3_assert(0);
}
}
u2_ha_free(har_u);
}
_road_dump();
}
// A simple memory tester.
//
int c3_cooked() { u2_cm_bail(c3__oops); return 0; }
int
main(int argc, char *argv[])
{
printf("hello, world: len %dMB\n", (1 << U2_OS_LoomBits) >> 18);
// _test_words();
u2_cm_boot(U2_OS_LoomBase, (1 << U2_OS_LoomBits));
printf("booted.\n");
_test_jam();
}

25
gen164/1/add.c
View File

@ -8,23 +8,28 @@
/* functions
*/
u2_weak // transfer
j2_mbc(Pt1, add)(
u2_atom a, // retain
j2_mbc(Pt1, add)(u2_atom a, // retain
u2_atom b) // retain
{
mpz_t a_mp, b_mp;
if ( u2_so(u2_co_is_cat(a)) && u2_so(u2_co_is_cat(b)) ) {
c3_w c = a + b;
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
return u2_ci_words(1, &c);
}
else {
mpz_t a_mp, b_mp;
mpz_add(a_mp, a_mp, b_mp);
mpz_clear(b_mp);
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
return u2_ci_mp(a_mp);
mpz_add(a_mp, a_mp, b_mp);
mpz_clear(b_mp);
return u2_ci_mp(a_mp);
}
}
u2_weak // transfer
j2_mb(Pt1, add)(
u2_noun cor) // retain
j2_mb(Pt1, add)(u2_noun cor) // retain
{
u2_noun a, b;

23
gen164/1/dec.c
View File

@ -8,32 +8,33 @@
/* functions
*/
u2_weak // transfer
j2_mbc(Pt1, inc)(
u2_atom a) // retain
j2_mbc(Pt1, inc)(u2_atom a) // retain
{
return u2_ci_vint(u2k(a));
}
u2_weak // transfer
j2_mbc(Pt1, dec)(
u2_atom a) // retain
j2_mbc(Pt1, dec)(u2_atom a) // retain
{
if ( 0 == a ) {
return u2_cm_error("decrement-underflow");
return u2_cm_bail(c3__exit);
}
else {
mpz_t a_mp;
if ( u2_so(u2_co_is_cat(a)) ) {
return a - 1;
}
else {
mpz_t a_mp;
u2_cr_mp(a_mp, a);
mpz_sub_ui(a_mp, a_mp, 1);
u2_cr_mp(a_mp, a);
mpz_sub_ui(a_mp, a_mp, 1);
return u2_ci_mp(a_mp);
return u2_ci_mp(a_mp);
}
}
}
u2_weak // transfer
j2_mb(Pt1, dec)(
u2_noun cor) // retain
j2_mb(Pt1, dec)(u2_noun cor) // retain
{
u2_noun a;

23
gen164/1/div.c
View File

@ -8,28 +8,31 @@
/* functions
*/
u2_weak // transfer
j2_mbc(Pt1, div)(
u2_atom a, // retain
j2_mbc(Pt1, div)(u2_atom a, // retain
u2_atom b) // retain
{
if ( 0 == b ) {
return u2_cm_bail(c3__exit);
}
else {
mpz_t a_mp, b_mp;
if ( u2_so(u2_co_is_cat(a)) && u2_so(u2_co_is_cat(b)) ) {
return a / b;
}
else {
mpz_t a_mp, b_mp;
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
mpz_tdiv_q(a_mp, a_mp, b_mp);
mpz_clear(b_mp);
mpz_tdiv_q(a_mp, a_mp, b_mp);
mpz_clear(b_mp);
return u2_ci_mp(a_mp);
return u2_ci_mp(a_mp);
}
}
}
u2_weak // transfer
j2_mb(Pt1, div)(
u2_noun cor) // retain
j2_mb(Pt1, div)(u2_noun cor) // retain
{
u2_noun a, b;

21
gen164/1/gte.c
View File

@ -12,18 +12,23 @@
u2_atom a, // retain
u2_atom b) // retain
{
mpz_t a_mp, b_mp;
u2_bean cmp;
if ( u2_co_is_cat(a) && u2_co_is_cat(b) ) {
return u2_say(a >= b);
}
else {
mpz_t a_mp, b_mp;
u2_bean cmp;
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
cmp = (mpz_cmp(a_mp, b_mp) >= 0) ? u2_yes : u2_no;
cmp = (mpz_cmp(a_mp, b_mp) >= 0) ? u2_yes : u2_no;
mpz_clear(a_mp);
mpz_clear(b_mp);
mpz_clear(a_mp);
mpz_clear(b_mp);
return cmp;
return cmp;
}
}
u2_weak // transfer
j2_mb(Pt1, gte)(

27
gen164/1/gth.c
View File

@ -8,26 +8,29 @@
/* functions
*/
u2_weak // transfer
j2_mbc(Pt1, gth)(
u2_atom a, // retain
j2_mbc(Pt1, gth)(u2_atom a, // retain
u2_atom b) // retain
{
mpz_t a_mp, b_mp;
u2_bean cmp;
if ( u2_co_is_cat(a) && u2_co_is_cat(b) ) {
return u2_say(a > b);
}
else {
mpz_t a_mp, b_mp;
u2_bean cmp;
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
cmp = (mpz_cmp(a_mp, b_mp) > 0) ? u2_yes : u2_no;
cmp = (mpz_cmp(a_mp, b_mp) > 0) ? u2_yes : u2_no;
mpz_clear(a_mp);
mpz_clear(b_mp);
mpz_clear(a_mp);
mpz_clear(b_mp);
return cmp;
return cmp;
}
}
u2_weak // transfer
j2_mb(Pt1, gth)(
u2_noun cor) // retain
j2_mb(Pt1, gth)(u2_noun cor) // retain
{
u2_noun a, b;

27
gen164/1/lte.c
View File

@ -8,26 +8,29 @@
/* functions
*/
u2_weak // transfer
j2_mbc(Pt1, lte)(
u2_atom a, // retain
j2_mbc(Pt1, lte)(u2_atom a, // retain
u2_atom b) // retain
{
mpz_t a_mp, b_mp;
u2_bean cmp;
if ( u2_co_is_cat(a) && u2_co_is_cat(b) ) {
return u2_say(a <= b);
}
else {
mpz_t a_mp, b_mp;
u2_bean cmp;
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
cmp = (mpz_cmp(a_mp, b_mp) <= 0) ? u2_yes : u2_no;
cmp = (mpz_cmp(a_mp, b_mp) <= 0) ? u2_yes : u2_no;
mpz_clear(a_mp);
mpz_clear(b_mp);
mpz_clear(a_mp);
mpz_clear(b_mp);
return cmp;
return cmp;
}
}
u2_weak // transfer
j2_mb(Pt1, lte)(
u2_noun cor) // retain
j2_mb(Pt1, lte)(u2_noun cor) // retain
{
u2_noun a, b;

27
gen164/1/lth.c
View File

@ -8,26 +8,29 @@
/* functions
*/
u2_weak // transfer
j2_mbc(Pt1, lth)(
u2_atom a, // retain
j2_mbc(Pt1, lth)(u2_atom a, // retain
u2_atom b) // retain
{
mpz_t a_mp, b_mp;
u2_bean cmp;
if ( u2_co_is_cat(a) && u2_co_is_cat(b) ) {
return u2_say(a <= b);
}
else {
mpz_t a_mp, b_mp;
u2_bean cmp;
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
cmp = (mpz_cmp(a_mp, b_mp) < 0) ? u2_yes : u2_no;
cmp = (mpz_cmp(a_mp, b_mp) < 0) ? u2_yes : u2_no;
mpz_clear(a_mp);
mpz_clear(b_mp);
mpz_clear(a_mp);
mpz_clear(b_mp);
return cmp;
return cmp;
}
}
u2_weak // transfer
j2_mb(Pt1, lth)(
u2_noun cor) // retain
j2_mb(Pt1, lth)(u2_noun cor) // retain
{
u2_noun a, b;

25
gen164/1/mul.c
View File

@ -8,23 +8,28 @@
/* functions
*/
u2_weak // transfer
j2_mbc(Pt1, mul)(
u2_atom a, // retain
j2_mbc(Pt1, mul)(u2_atom a, // retain
u2_atom b) // retain
{
mpz_t a_mp, b_mp;
if ( u2_so(u2_co_is_cat(a)) && u2_so(u2_co_is_cat(b)) ) {
c3_d c = ((c3_d) a) * ((c3_d) b);
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
return u2_ci_chubs(1, &c);
}
else {
mpz_t a_mp, b_mp;
mpz_mul(a_mp, a_mp, b_mp);
mpz_clear(b_mp);
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
return u2_ci_mp(a_mp);
mpz_mul(a_mp, a_mp, b_mp);
mpz_clear(b_mp);
return u2_ci_mp(a_mp);
}
}
u2_weak // transfer
j2_mb(Pt1, mul)(
u2_noun cor) // retain
j2_mb(Pt1, mul)(u2_noun cor) // retain
{
u2_noun a, b;

31
gen164/1/sub.c
View File

@ -8,25 +8,32 @@
/* functions
*/
u2_weak // transfer
j2_mbc(Pt1, sub)(
u2_atom a, // retain
j2_mbc(Pt1, sub)(u2_atom a, // retain
u2_atom b) // retain
{
mpz_t a_mp, b_mp;
if ( u2_so(u2_co_is_cat(a)) && u2_so(u2_co_is_cat(b)) ) {
if ( a < b ) {
return u2_cm_error("subtract-underflow");
}
else return (a - b);
}
else {
mpz_t a_mp, b_mp;
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
u2_cr_mp(a_mp, a);
u2_cr_mp(b_mp, b);
if ( mpz_cmp(a_mp, b_mp) < 0 ) {
mpz_clear(a_mp);
if ( mpz_cmp(a_mp, b_mp) < 0 ) {
mpz_clear(a_mp);
mpz_clear(b_mp);
return u2_cm_error("subtract-underflow");
}
mpz_sub(a_mp, a_mp, b_mp);
mpz_clear(b_mp);
return u2_cm_error("subtract-underflow");
return u2_ci_mp(a_mp);
}
mpz_sub(a_mp, a_mp, b_mp);
mpz_clear(b_mp);
return u2_ci_mp(a_mp);
}
u2_weak // transfer
j2_mb(Pt1, sub)(

44
gen164/5/cue.c
View File

@ -4,15 +4,12 @@
*/
#include "all.h"
#include "../pit.h"
#include "f/nash.h"
/* functions
*/
struct u2_nash* T_r;
#include "f/pork.h"
static u2_noun // produce
_cue_in(u2_atom a, // retain
u2_atom b) // retain
_cue_in(u2_ha_root* har_u,
u2_atom a, // retain
u2_atom b) // retain
{
u2_noun p, q;
@ -22,7 +19,8 @@
p = j2_mbc(Pt1, inc)(u2k(u2h(c)));
q = u2k(u2t(c));
u2_na_put(T_r, b, (void*)(c3_p)q);
u2_ha_put(har_u, u2k(b), u2k(q));
u2z(c);
u2z(x);
@ -35,31 +33,28 @@
u2_noun u, v, w;
u2_noun x, y;
u = _cue_in(a, c);
u = _cue_in(har_u, a, c);
x = j2_mbc(Pt1, add)(u2h(u), c);
v = _cue_in(a, x);
w = u2nc(u2k(u2h(u2t(u))),
u2k(u2h(u2t(v))));
v = _cue_in(har_u, a, x);
w = u2nc(u2k(u2h(u2t(u))), u2k(u2h(u2t(v))));
y = j2_mbc(Pt1, add)(u2h(u), u2h(v));
p = j2_mbc(Pt1, add)(2, y);
q = w;
u2_na_put(T_r, b, (void*)(c3_p)q);
u2_ha_put(har_u, u2k(b), u2k(q));
u2z(u); u2z(v); u2z(x); u2z(y);
}
else {
u2_noun d = j2_mby(Pt5, rub)(c, a);
u2_noun x = u2_na_get(T_r, u2t(d));
u2_noun x = u2_ha_get(har_u, u2k(u2t(d)));
p = j2_mbc(Pt1, add)(2, u2h(d));
if ( u2_none == x ) {
return u2_cm_bail(c3__exit);
}
q = u2k(x);
q = x;
u2z(d);
}
u2z(l);
@ -69,23 +64,20 @@
}
u2_noun // transfer
j2_mby(Pt5, cue)(
u2_atom a) // retain
j2_mby(Pt5, cue)(u2_atom a) // retain
{
T_r = u2_na_make();
u2_ha_root* har_u = u2_ha_new();
u2_noun x = _cue_in(a, 0);
u2_noun x = _cue_in(har_u, a, 0);
u2_noun y = u2k(u2h(u2t(x)));
u2_na_take(T_r);
T_r = 0;
u2_ha_free(har_u);
u2z(x);
return y;
}
u2_noun // transfer
j2_mb(Pt5, cue)(
u2_noun cor) // retain
j2_mb(Pt5, cue)(u2_noun cor) // retain
{
u2_noun a;

61
gen164/5/jam.c
View File

@ -4,15 +4,15 @@
*/
#include "all.h"
#include "../pit.h"
#include "f/nash.h"
#include "f/pork.h"
/* functions
*/
struct u2_nash* T_m;
static u2_noun
_jam_in(u2_atom, u2_atom, u2_noun);
_jam_in(u2_ha_root* har_u, u2_atom, u2_atom, u2_noun);
static u2_noun // produce
_jam_in_pair(
_jam_in_pair(u2_ha_root* har_u,
u2_atom h_a, // retain
u2_atom t_a, // retain
u2_atom b, // retain
@ -20,24 +20,21 @@
{
u2_noun w = u2nc(u2nc(2, 1), u2k(l));
u2_noun x = j2_mbc(Pt1, add)(2, b);
u2_noun d = _jam_in(h_a, x, w);
u2_noun d = _jam_in(har_u, h_a, x, w);
u2_noun p_d, q_d, r_d;
u2_noun r;
u2_cr_trel(d, &p_d, &q_d, &r_d);
{
u2_noun y = j2_mbc(Pt1, add)(x, p_d);
u2_noun e = _jam_in(t_a, y, q_d);
u2_noun e = _jam_in(har_u, t_a, y, q_d);
u2_noun p_e, q_e, r_e;
u2_cr_trel(e, &p_e, &q_e, &r_e);
{
u2_noun z = j2_mbc(Pt1, add)(p_d, p_e);
r = u2nt
(j2_mbc(Pt1, add)(2, z),
u2k(q_e),
0);
r = u2nt(j2_mbc(Pt1, add)(2, z), u2k(q_e), 0);
u2z(z);
}
@ -52,19 +49,14 @@
}
static u2_noun // produce
_jam_in_flat(
_jam_in_flat(u2_ha_root* har_u,
u2_atom a, // retain
u2_noun l) // retain
{
u2_noun d = j2_mby(Pt5, mat)(a);
u2_noun x = j2_mbc(Pt1, add)(1, u2h(d));
u2_noun y = u2nt
(u2k(x),
u2nc(u2nc(
x,
j2_mbc(Pt3, lsh)(0, 1, u2t(d))),
u2k(l)),
0);
(u2k(x), u2nc(u2nc(x, j2_mbc(Pt3, lsh)(0, 1, u2t(d))), u2k(l)), 0);
u2z(d);
@ -72,7 +64,7 @@
}
static u2_noun // produce
_jam_in_ptr(
_jam_in_ptr(u2_ha_root* har_u,
u2_atom u_c, // retain
u2_noun l) // retain
{
@ -80,10 +72,7 @@
u2_atom x = j2_mbc(Pt3, lsh)(0, 2, u2t(d));
u2_atom y = j2_mbc(Pt1, add)(2, u2h(d));
u2_noun z = u2nt
(u2k(y),
u2nc(u2nc(y, j2_mbc(Pt3, mix)(3, x)),
u2k(l)),
0);
(u2k(y), u2nc(u2nc(y, j2_mbc(Pt3, mix)(3, x)), u2k(l)), 0);
u2z(d);
u2z(x);
@ -92,52 +81,50 @@
}
static u2_noun // produce
_jam_in(
_jam_in(u2_ha_root* har_u,
u2_noun a, // retain
u2_atom b, // retain
u2_noun l) // retain
{
u2_noun c = u2_na_get(T_m, a);
u2_noun c = u2_ha_get(har_u, u2k(a));
u2_noun x;
if ( u2_none == c ) {
u2_na_put(T_m, a, (void*)(c3_p)b);
u2_ha_put(har_u, u2k(a), u2k(b));
if ( u2_yes == u2ud(a) ) {
x = _jam_in_flat(a, l);
x = _jam_in_flat(har_u, a, l);
} else {
x = _jam_in_pair(u2h(a), u2t(a), b, l);
x = _jam_in_pair(har_u, u2h(a), u2t(a), b, l);
}
}
else {
if ( u2_yes == u2ud(a) && u2_cr_met(0, a) <= u2_cr_met(0, c) ) {
x = _jam_in_flat(a, l);
x = _jam_in_flat(har_u, a, l);
}
else {
x = _jam_in_ptr(c, l);
x = _jam_in_ptr(har_u, c, l);
}
}
return x;
}
u2_noun // transfer
j2_mby(Pt5, jam)(
u2_atom a) // retain
j2_mby(Pt5, jam)(u2_atom a) // retain
{
T_m = u2_na_make();
u2_noun x = _jam_in(a, 0, u2_nul);
u2_ha_root* har_u = u2_ha_new();
u2_noun x = _jam_in(har_u, a, 0, u2_nul);
u2_noun q = j2_mbc(Pt2, flop)(u2h(u2t(x)));
u2_noun r = j2_mbc(Pt3, can)(0, q);
u2z(x);
u2z(q);
u2_na_take(T_m);
T_m = NULL;
u2_ha_free(har_u);
return r;
}
u2_noun // transfer
j2_mb(Pt5, jam)(
u2_noun cor) // retain
j2_mb(Pt5, jam)(u2_noun cor) // retain
{
u2_noun a;

14
include/f/meme.h
View File

@ -9,6 +9,7 @@
*** u2_ch_: memoization.
*** u2_ci_: noun constructors
*** u2_cj_: jets.
*** u2_ck_: direct jet calls.
*** u2_cm_: system management etc.
*** u2_cn_: nock interpreter.
*** u2_co_: fundamental macros.
@ -40,7 +41,7 @@
**/
/* u2_yes, u2_no, u2_nul;
**
** Our Martian booleans and list terminator; empty string; not a nonu.
** Our Martian booleans and list terminator; empty string; not a noun.
*/
# define u2_yes 0
# define u2_no 1
@ -179,7 +180,7 @@
# define u2_co_is_pug(som) ((2 == ((som) >> 30)) ? u2_yes : u2_no)
# define u2_co_is_pom(som) ((3 == ((som) >> 30)) ? u2_yes : u2_no)
# define u2_co_to_off(som) ((som) & 0x3fffffff)
# define u2_co_to_ptr(som) ((void *)(u2_co_into(u2_co_to_off(som))))
# define u2_co_to_ptr(som) (u2_co_into(u2_co_to_off(som)))
# define u2_co_to_pug(off) (off | 0x80000000)
# define u2_co_to_pom(off) (off | 0xc0000000)
@ -392,7 +393,7 @@
? (c3_w)(u2R->cap_w - u2R->hat_w) \
: (c3_w)(u2R->hat_w - u2R->cap_w) )
# define u2_co_into(x) (u2_Loom + (x))
# define u2_co_into(x) ((void *)(u2_Loom + (x)))
# define u2_co_outa(p) (((c3_w*)(void*)(p)) - u2_Loom)
@ -942,7 +943,12 @@
void
u2_ca_free(void* lag_v);
/* u2_ca_realloc(): crude realloc.
/* u2_ca_wealloc(): word realloc.
*/
void*
u2_ca_wealloc(void* lag_v, c3_w len_w);
/* u2_ca_realloc(): byte realloc.
*/
void*
u2_ca_realloc(void* lag_v, c3_w len_w);

81
include/f/plow.h
View File

@ -1,81 +0,0 @@
/* f/plow.h
**
** This file is in the public domain.
*/
/** Data structures.
**/
/* u2_loom_plow: temporary plow structure.
*/
typedef struct {
/* Set [*type *gene] in repo.
*/
u2_pool fan;
/* Set [*type] in verify.
*/
u2_pool ver;
/* Debug depth.
*/
u2_atom bug;
/* Trap - *(list &[p=*text q=*spot])
*/
u2_noun meb;
/* Book to memoize nest.
*/
u2_book vus;
/* Book to memoize null.
*/
u2_book tyc;
/* Book to memoize orth.
*/
u2_book gam;
/* Book to memoize show.
*/
u2_book hos;
/* Book to memoize play.
*/
u2_book zor;
/* Book to memoize make.
*/
u2_book niq;
/* Book to memoize safe.
*/
u2_book fac;
/* Book to memoize fine.
*/
u2_book vom;
/* Book to memoize open.
*/
u2_book pon;
/* Book to memoize find.
*/
u2_book fin;
/* Book to memoize half.
*/
u2_book huf;
} u2_loom_plow;
# define u2_plow_(wir_r, pat) \
*u2_at(u2_wire_plo_r(wir_r), u2_loom_plow, pat)
/** Functions.
**/
/* u2_pl_boot():
**
** Initialize plow support context.
*/
void
u2_pl_boot(u2_ray wir_r);