diff options
author | polwex <polwex@sortug.com> | 2025-10-05 21:56:51 +0700 |
---|---|---|
committer | polwex <polwex@sortug.com> | 2025-10-05 21:56:51 +0700 |
commit | fcedfddf00b3f994e4f4e40332ac7fc192c63244 (patch) | |
tree | 51d38e62c7bdfcc5f9a5e9435fe820c93cfc9a3d /vere/pkg/noun/allocate.c |
claude is gud
Diffstat (limited to 'vere/pkg/noun/allocate.c')
-rw-r--r-- | vere/pkg/noun/allocate.c | 2012 |
1 files changed, 2012 insertions, 0 deletions
diff --git a/vere/pkg/noun/allocate.c b/vere/pkg/noun/allocate.c new file mode 100644 index 0000000..96a09b2 --- /dev/null +++ b/vere/pkg/noun/allocate.c @@ -0,0 +1,2012 @@ +/// @file + +#include "allocate.h" + +#include "hashtable.h" +#include "log.h" +#include "manage.h" +#include "options.h" +#include "retrieve.h" +#include "trace.h" +#include "vortex.h" + +#include "palloc.c" + +u3_road* u3a_Road; +u3a_mark u3a_Mark; +u3a_gack u3a_Gack; +u3a_hunk_dose u3a_Hunk[u3a_crag_no]; + +#ifdef U3_MEMORY_DEBUG +c3_w u3_Code; +#endif + +c3_w u3a_to_pug(c3_w off); +c3_w u3a_to_pom(c3_w off); + +void +u3a_drop(const u3a_pile* pil_u); +void* +u3a_peek(const u3a_pile* pil_u); +void* +u3a_pop(const u3a_pile* pil_u); +void* +u3a_push(const u3a_pile* pil_u); +c3_o +u3a_pile_done(const u3a_pile* pil_u); + +void* +u3a_into_fn(u3_post som_p) +{ + return u3a_into(som_p); +} + +u3_post +u3a_outa_fn(void* som_v) +{ + return u3a_outa(som_v); +} + +u3_post +u3a_to_off_fn(u3_noun som) +{ + return u3a_to_off(som); +} + +u3a_noun* +u3a_to_ptr_fn(u3_noun som) +{ + return u3a_to_ptr(som); +} + +u3_noun +u3a_head(u3_noun som) +{ + return u3h(som); +} + +u3_noun +u3a_tail(u3_noun som) +{ + return u3t(som); +} + +void +u3a_post_info(u3_post som_p) +{ + _post_status(som_p); +} + +void +u3a_init_once(void) +{ + _init_once(); +} + +void +u3a_init_heap(void) +{ + _init_heap(); +} + +void +u3a_drop_heap(u3_post cap_p, u3_post ear_p) +{ +#ifdef ASAN_ENABLED + if ( cap_p > ear_p ) { // in north, drop inner south + _drop(ear_p, cap_p - ear_p); + } + else { // in south, drop inner north + _drop(cap_p, ear_p - cap_p); + } +#else + (void)cap_p; + (void)ear_p; +#endif +} + +void +u3a_mark_init(void) +{ + c3_w bit_w = (u3R->hep.len_w + 31) >> 5; + + u3a_Mark.bit_w = c3_calloc(sizeof(c3_w) * bit_w); + u3a_Mark.siz_w = u3R->hep.siz_w * 2; + u3a_Mark.len_w = u3R->hep.len_w; + u3a_Mark.buf_w = c3_calloc(sizeof(c3_w) * u3a_Mark.siz_w); + + memset(u3a_Mark.wee_w, 0, sizeof(c3_w) * u3a_crag_no); +} + +void +u3a_mark_done(void) +{ + c3_free(u3a_Mark.bit_w); + c3_free(u3a_Mark.buf_w); + memset(&u3a_Mark, 0, sizeof(u3a_Mark)); +} + +void* +u3a_mark_alloc(c3_w len_w) // words +{ + void* ptr_v; + + if ( len_w > (u3a_Mark.siz_w - u3a_Mark.len_w) ) { + u3a_Mark.siz_w += c3_max(u3a_Mark.len_w, len_w); + u3a_Mark.buf_w = c3_realloc(u3a_Mark.buf_w, sizeof(c3_w) * u3a_Mark.siz_w); + } + + ptr_v = &(u3a_Mark.buf_w[u3a_Mark.len_w]); + u3a_Mark.len_w += len_w; + + return ptr_v; +} + +void +u3a_pack_init(void) +{ + c3_w bit_w = (u3R->hep.len_w + 31) >> 5; + u3a_Gack.bit_w = c3_calloc(sizeof(c3_w) * bit_w); + u3a_Gack.pap_w = c3_calloc(sizeof(c3_w) * bit_w); + u3a_Gack.pum_w = c3_calloc(sizeof(c3_w) * bit_w); + + u3a_Gack.siz_w = u3R->hep.siz_w * 2; + u3a_Gack.len_w = u3R->hep.len_w; + u3a_Gack.buf_w = c3_calloc(sizeof(c3_w) * u3a_Gack.siz_w); +} + +void* +u3a_pack_alloc(c3_w len_w) // words +{ + void* ptr_v; + + if ( len_w > (u3a_Gack.siz_w - u3a_Gack.len_w) ) { + u3a_Gack.siz_w += c3_max(u3a_Gack.len_w, len_w); + u3a_Gack.buf_w = c3_realloc(u3a_Gack.buf_w, sizeof(c3_w) * u3a_Gack.siz_w); + } + + ptr_v = &(u3a_Gack.buf_w[u3a_Gack.len_w]); + u3a_Gack.len_w += len_w; + + return ptr_v; +} + +void +u3a_pack_done(void) +{ + c3_free(u3a_Gack.pap_w); + c3_free(u3a_Gack.pum_w); + c3_free(u3a_Gack.buf_w); +} + +/* _box_count(): adjust memory count. +*/ +#ifdef U3_CPU_DEBUG +static void +_box_count(c3_ws siz_ws) +{ + u3R->all.fre_w += siz_ws; + + { + c3_w end_w = u3a_heap(u3R); + c3_w all_w = (end_w - u3R->all.fre_w); + + if ( all_w > u3R->all.max_w ) { + u3R->all.max_w = all_w; + } + } +} +#else +static void +_box_count(c3_ws siz_ws) { } +#endif + +/* _ca_reclaim_half(): reclaim from memoization cache. +*/ +static void +_ca_reclaim_half(void) +{ + // XX u3l_log avoid here, as it can + // cause problems when handling errors + + if ( (0 == u3R->cax.har_p) || + (0 == u3to(u3h_root, u3R->cax.har_p)->use_w) ) + { + fprintf(stderr, "allocate: reclaim: memo cache: empty\r\n"); + u3m_bail(c3__meme); + } + +#if 1 + fprintf(stderr, "allocate: reclaim: half of %d entries\r\n", + u3to(u3h_root, u3R->cax.har_p)->use_w); + + u3h_trim_to(u3R->cax.har_p, u3to(u3h_root, u3R->cax.har_p)->use_w / 2); +#else + /* brutal and guaranteed effective + */ + u3h_free(u3R->cax.har_p); + u3R->cax.har_p = u3h_new(); +#endif +} + +/* u3a_walloc(): allocate storage words on hat heap. +*/ +void* +u3a_walloc(c3_w len_w) +{ + return u3a_into(_imalloc(len_w)); +} + +/* u3a_wealloc(): realloc in words. +*/ +void* +u3a_wealloc(void* lag_v, c3_w len_w) +{ + if ( !lag_v ) { + return u3a_walloc(len_w); + } + + return u3a_into(_irealloc(u3a_outa(lag_v), len_w)); +} + +/* u3a_pile_prep(): initialize stack control. +*/ +void +u3a_pile_prep(u3a_pile* pil_u, c3_w len_w) +{ + // frame size, in words + // + c3_w wor_w = (len_w + 3) >> 2; + c3_o nor_o = u3a_is_north(u3R); + + pil_u->mov_ws = (c3y == nor_o) ? -wor_w : wor_w; + pil_u->off_ws = (c3y == nor_o) ? 0 : -wor_w; + pil_u->top_p = u3R->cap_p; + +#ifdef U3_MEMORY_DEBUG + pil_u->rod_u = u3R; +#endif +} + +/* u3a_wfree(): free storage. +*/ +void +u3a_wfree(void* tox_v) +{ + if ( tox_v ) { + _ifree(u3a_outa(tox_v)); + } +} + +/* u3a_wtrim(): trim storage. + + old_w - old length + len_w - new length +*/ +void +u3a_wtrim(void* tox_v, c3_w old_w, c3_w len_w) +{ + // XX realloc? +} + +/* u3a_calloc(): allocate and zero-initialize array +*/ +void* +u3a_calloc(size_t num_i, size_t len_i) +{ + size_t byt_i = num_i * len_i; + c3_w* out_w; + + u3_assert(byt_i / len_i == num_i); + out_w = u3a_malloc(byt_i); + memset(out_w, 0, byt_i); + + return out_w; +} + +/* u3a_malloc(): aligned storage measured in bytes. + + Internally pads allocations to 16-byte alignment independent of DWORD + alignment ensured for word sized allocations. + +*/ +void* +u3a_malloc(size_t len_i) +{ + return u3a_walloc((len_i + 3) >> 2); +} + +/* u3a_celloc(): allocate a cell. +*/ +c3_w* +u3a_celloc(void) +{ + u3a_cell *cel_u; + u3_post *cel_p; + + if ( u3R->cel.cel_p ) { + cel_p = u3to(u3_post, u3R->cel.cel_p); + + if ( !u3R->cel.hav_w ) { + _rake_chunks(c3_wiseof(*cel_u), (1U << u3a_page), + (u3R->cel.bat_w++ & 1), &u3R->cel.hav_w, cel_p); + } + + cel_u = u3to(u3a_cell, cel_p[--u3R->cel.hav_w]); + } + else { + cel_u = u3a_walloc(c3_wiseof(*cel_u)); + } + +#ifdef U3_CPU_DEBUG + u3R->pro.cel_d++; +#endif + + return (c3_w*)cel_u; +} + + +/* u3a_cfree(): free a cell. +*/ +void +u3a_cfree(c3_w* cel_w) +{ + u3_post *cel_p; + + if ( u3R->cel.cel_p ) { + if ( u3R->cel.hav_w < (1U << u3a_page) ) { + cel_p = u3to(u3_post, u3R->cel.cel_p); + cel_p[u3R->cel.hav_w++] = u3a_outa(cel_w); + return; + } + } + + u3a_wfree(cel_w); +} + +/* u3a_realloc(): aligned realloc in bytes. +*/ +void* +u3a_realloc(void* lag_v, size_t len_i) +{ + if ( !lag_v ) { + return u3a_malloc(len_i); + } + + return u3a_wealloc(lag_v, (len_i + 3) >> 2); +} + +/* u3a_free(): free for aligned malloc. +*/ +void +u3a_free(void* tox_v) +{ + u3a_wfree((c3_w*)tox_v); +} + +/* _me_wash_north(): clean up mug slots after copy. +*/ +static void _me_wash_north(u3_noun dog); +static void +_me_wash_north_in(u3_noun som) +{ + if ( _(u3a_is_cat(som)) ) return; + if ( !_(u3a_north_is_junior(u3R, som)) ) return; + + _me_wash_north(som); +} +static void +_me_wash_north(u3_noun dog) +{ + u3_assert(c3y == u3a_is_dog(dog)); + // u3_assert(c3y == u3a_north_is_junior(u3R, dog)); + { + u3a_noun* dog_u = u3a_to_ptr(dog); + + if ( dog_u->mug_w == 0 ) return; + + dog_u->mug_w = 0; // power wash + // if ( dog_u->mug_w >> 31 ) { dog_u->mug_w = 0; } + + if ( _(u3a_is_pom(dog)) ) { + u3a_cell* god_u = (u3a_cell *)(void *)dog_u; + + _me_wash_north_in(god_u->hed); + _me_wash_north_in(god_u->tel); + } + } +} + +/* _me_wash_south(): clean up mug slots after copy. +*/ +static void _me_wash_south(u3_noun dog); +static void +_me_wash_south_in(u3_noun som) +{ + if ( _(u3a_is_cat(som)) ) return; + if ( !_(u3a_south_is_junior(u3R, som)) ) return; + + _me_wash_south(som); +} +static void +_me_wash_south(u3_noun dog) +{ + u3_assert(c3y == u3a_is_dog(dog)); + // u3_assert(c3y == u3a_south_is_junior(u3R, dog)); + { + u3a_noun* dog_u = u3a_to_ptr(dog); + + if ( dog_u->mug_w == 0 ) return; + + dog_u->mug_w = 0; // power wash + // if ( dog_u->mug_w >> 31 ) { dog_u->mug_w = 0; } + + if ( _(u3a_is_pom(dog)) ) { + u3a_cell* god_u = (u3a_cell *)(void *)dog_u; + + _me_wash_south_in(god_u->hed); + _me_wash_south_in(god_u->tel); + } + } +} + +/* u3a_wash(): wash all lazy mugs. RETAIN. +*/ +void +u3a_wash(u3_noun som) +{ + if ( _(u3a_is_cat(som)) ) { + return; + } + if ( _(u3a_is_north(u3R)) ) { + if ( _(u3a_north_is_junior(u3R, som)) ) { + _me_wash_north(som); + } + } + else { + if ( _(u3a_south_is_junior(u3R, som)) ) { + _me_wash_south(som); + } + } +} + +/* _me_gain_use(): increment use count. +*/ +static void +_me_gain_use(u3_noun dog) +{ + u3a_noun* box_u = u3a_to_ptr(dog); + + if ( 0x7fffffff == box_u->use_w ) { + u3l_log("fail in _me_gain_use"); + u3m_bail(c3__fail); + } + else { + if ( box_u->use_w == 0 ) { + u3m_bail(c3__foul); + } + box_u->use_w += 1; + +#ifdef U3_MEMORY_DEBUG + // enable to (maybe) help track down leaks + // + // if ( u3_Code && !box_u->cod_w ) { box_u->cod_w = u3_Code; } +#endif + } +} + +#undef VERBOSE_TAKE + +/* _ca_take_atom(): reallocate an indirect atom off the stack. +*/ +static inline u3_atom +_ca_take_atom(u3a_atom* old_u) +{ + c3_w* new_w = u3a_walloc(old_u->len_w + c3_wiseof(u3a_atom)); + u3a_atom* new_u = (u3a_atom*)(void *)new_w; + u3_noun new = u3a_to_pug(u3a_outa(new_u)); + + new_u->use_w = 1; + +#ifdef VERBOSE_TAKE + u3l_log("%s: atom %p to %p", ( c3y == u3a_is_north(u3R) ) + ? "north" + : "south", + old_u, + new_u); +#endif + + // XX use memcpy? + // + new_u->mug_w = old_u->mug_w; + new_u->len_w = old_u->len_w; + { + c3_w i_w; + + for ( i_w=0; i_w < old_u->len_w; i_w++ ) { + new_u->buf_w[i_w] = old_u->buf_w[i_w]; + } + } + + // borrow mug slot to record new destination in [old_u] + // + old_u->mug_w = new; + + return new; +} + +/* _ca_take_cell(): reallocate a cell off the stack. +*/ +static inline u3_cell +_ca_take_cell(u3a_cell* old_u, u3_noun hed, u3_noun tel) +{ + c3_w* new_w = u3a_celloc(); + u3a_cell* new_u = (u3a_cell*)(void *)new_w; + u3_cell new = u3a_to_pom(u3a_outa(new_u)); + +#ifdef VERBOSE_TAKE + u3l_log("%s: cell %p to %p", ( c3y == u3a_is_north(u3R) ) + ? "north" + : "south", + old_u, + new_u); +#endif + + new_u->use_w = 1; + new_u->mug_w = old_u->mug_w; + new_u->hed = hed; + new_u->tel = tel; + + // borrow mug slot to record new destination in [old_u] + // + old_u->mug_w = new; + + return new; +} + +/* _ca_take: stack frame for recording cell travesal +** (u3_none == hed) == head-frame +*/ +typedef struct _ca_take +{ + u3_weak hed; // taken head + u3_cell old; // old cell +} _ca_take; + +/* _ca_take_next_south: take next noun, pushing cells on stack. +*/ +static inline u3_noun +_ca_take_next_north(u3a_pile* pil_u, u3_noun veb) +{ + while ( 1 ) { + // direct atoms and senior refs are not counted. + // + if ( (c3y == u3a_is_cat(veb)) + || (c3y == u3a_north_is_senior(u3R, veb)) ) + { + return veb; + } + // not junior; normal (heap) refs on our road are counted. + // + else if ( c3n == u3a_north_is_junior(u3R, veb) ) { + _me_gain_use(veb); // bypass branches in u3k() + return veb; + } + // junior (stack) refs are copied. + // + else { + u3a_noun* veb_u = u3a_to_ptr(veb); + + // 32-bit mug_w: already copied [veb] and [mug_w] is the new ref. + // + if ( veb_u->mug_w >> 31 ) { + u3_noun nov = (u3_noun)veb_u->mug_w; + + u3_assert( c3y == u3a_north_is_normal(u3R, nov) ); + +#ifdef VERBOSE_TAKE + u3l_log("north: %p is already %p", veb_u, u3a_to_ptr(nov)); +#endif + + _me_gain_use(nov); // bypass branches in u3k() + return nov; + } + else if ( c3y == u3a_is_atom(veb) ) { + return _ca_take_atom((u3a_atom*)veb_u); + } + else { + u3a_cell* old_u = (u3a_cell*)veb_u; + _ca_take* fam_u = u3a_push(pil_u); + + fam_u->hed = u3_none; + fam_u->old = veb; + + veb = old_u->hed; + continue; + } + } + } +} + +/* _ca_take_next_south: take next noun, pushing cells on stack. +*/ +static inline u3_noun +_ca_take_next_south(u3a_pile* pil_u, u3_noun veb) +{ + while ( 1 ) { + // direct atoms and senior refs are not counted. + // + if ( (c3y == u3a_is_cat(veb)) + || (c3y == u3a_south_is_senior(u3R, veb)) ) + { + return veb; + } + // not junior; a normal pointer in our road -- refcounted + // + else if ( c3n == u3a_south_is_junior(u3R, veb) ) { + _me_gain_use(veb); // bypass branches in u3k() + return veb; + } + // junior (stack) refs are copied. + // + else { + u3a_noun* veb_u = u3a_to_ptr(veb); + + // 32-bit mug_w: already copied [veb] and [mug_w] is the new ref. + // + if ( veb_u->mug_w >> 31 ) { + u3_noun nov = (u3_noun)veb_u->mug_w; + + u3_assert( c3y == u3a_south_is_normal(u3R, nov) ); + +#ifdef VERBOSE_TAKE + u3l_log("south: %p is already %p", veb_u, u3a_to_ptr(nov)); +#endif + + _me_gain_use(nov); // bypass branches in u3k() + return nov; + } + else if ( c3y == u3a_is_atom(veb) ) { + return _ca_take_atom((u3a_atom*)veb_u); + } + else { + u3a_cell* old_u = (u3a_cell*)veb_u; + _ca_take* fam_u = u3a_push(pil_u); + + fam_u->hed = u3_none; + fam_u->old = veb; + + veb = old_u->hed; + continue; + } + } + } +} + +/* _ca_take_north(): in a north road, gain, copying juniors (from stack). +*/ +static u3_noun +_ca_take_north(u3_noun veb) +{ + u3_noun pro; + _ca_take* fam_u; + u3a_pile pil_u; + u3a_pile_prep(&pil_u, sizeof(*fam_u)); + + // commence taking + // + pro = _ca_take_next_north(&pil_u, veb); + + // process cell results + // + if ( c3n == u3a_pile_done(&pil_u) ) { + fam_u = u3a_peek(&pil_u); + + do { + // head-frame: stash copy and continue into the tail + // + if ( u3_none == fam_u->hed ) { + u3a_cell* old_u = u3a_to_ptr(fam_u->old); + fam_u->hed = pro; + pro = _ca_take_next_north(&pil_u, old_u->tel); + fam_u = u3a_peek(&pil_u); + } + // tail-frame: copy cell and pop the stack + // + else { + u3a_cell* old_u = u3a_to_ptr(fam_u->old); + pro = _ca_take_cell(old_u, fam_u->hed, pro); + fam_u = u3a_pop(&pil_u); + } + } while ( c3n == u3a_pile_done(&pil_u) ); + } + + return pro; +} +/* _ca_take_south(): in a south road, gain, copying juniors (from stack). +*/ +static u3_noun +_ca_take_south(u3_noun veb) +{ + u3_noun pro; + _ca_take* fam_u; + u3a_pile pil_u; + u3a_pile_prep(&pil_u, sizeof(*fam_u)); + + // commence taking + // + pro = _ca_take_next_south(&pil_u, veb); + + // process cell results + // + if ( c3n == u3a_pile_done(&pil_u) ) { + fam_u = u3a_peek(&pil_u); + + do { + // head-frame: stash copy and continue into the tail + // + if ( u3_none == fam_u->hed ) { + u3a_cell* old_u = u3a_to_ptr(fam_u->old); + fam_u->hed = pro; + pro = _ca_take_next_south(&pil_u, old_u->tel); + fam_u = u3a_peek(&pil_u); + } + // tail-frame: copy cell and pop the stack + // + else { + u3a_cell* old_u = u3a_to_ptr(fam_u->old); + pro = _ca_take_cell(old_u, fam_u->hed, pro); + fam_u = u3a_pop(&pil_u); + } + } while ( c3n == u3a_pile_done(&pil_u) ); + } + + return pro; +} + +/* u3a_take(): gain, copying juniors. +*/ +u3_noun +u3a_take(u3_noun veb) +{ + u3_noun pro; + u3t_on(coy_o); + + u3_assert(u3_none != veb); + + pro = ( c3y == u3a_is_north(u3R) ) + ? _ca_take_north(veb) + : _ca_take_south(veb); + + u3t_off(coy_o); + return pro; +} + +/* u3a_left(): true of junior if preserved. +*/ +c3_o +u3a_left(u3_noun som) +{ + if ( _(u3a_is_cat(som)) || + !_(u3a_is_junior(u3R, som)) ) + { + return c3y; + } + else { + u3a_noun* dog_u = u3a_to_ptr(som); + + return __(0 != (dog_u->mug_w >> 31)); + } +} + +/* _me_gain_north(): gain on a north road. +*/ +static u3_noun +_me_gain_north(u3_noun dog) +{ + if ( c3y == u3a_north_is_senior(u3R, dog) ) { + /* senior pointers are not refcounted + */ + return dog; + } + else { + /* junior nouns are disallowed + */ + u3_assert(!_(u3a_north_is_junior(u3R, dog))); + + /* normal pointers are refcounted + */ + _me_gain_use(dog); + return dog; + } +} + +/* _me_gain_south(): gain on a south road. +*/ +static u3_noun +_me_gain_south(u3_noun dog) +{ + if ( c3y == u3a_south_is_senior(u3R, dog) ) { + /* senior pointers are not refcounted + */ + return dog; + } + else { + /* junior nouns are disallowed + */ + u3_assert(!_(u3a_south_is_junior(u3R, dog))); + + /* normal nouns are refcounted + */ + _me_gain_use(dog); + return dog; + } +} + +/* _me_lose_north(): lose on a north road. +*/ +static void +_me_lose_north(u3_noun dog) +{ +top: + if ( c3y == u3a_north_is_normal(u3R, dog) ) { + u3a_noun* box_u = u3a_to_ptr(dog); + + if ( box_u->use_w > 1 ) { + box_u->use_w -= 1; + } + else { + if ( 0 == box_u->use_w ) { + u3m_bail(c3__foul); + } + else { + if ( _(u3a_is_pom(dog)) ) { + u3a_cell* dog_u = (void*)box_u; + u3_noun h_dog = dog_u->hed; + u3_noun t_dog = dog_u->tel; + + if ( !_(u3a_is_cat(h_dog)) ) { + _me_lose_north(h_dog); + } + u3a_cfree((c3_w*)dog_u); + if ( !_(u3a_is_cat(t_dog)) ) { + dog = t_dog; + goto top; + } + } + else { + u3a_wfree(box_u); + } + } + } + } +} + +/* _me_lose_south(): lose on a south road. +*/ +static void +_me_lose_south(u3_noun dog) +{ +top: + if ( c3y == u3a_south_is_normal(u3R, dog) ) { + u3a_noun* box_u = u3a_to_ptr(dog); + + if ( box_u->use_w > 1 ) { + box_u->use_w -= 1; + } + else { + if ( 0 == box_u->use_w ) { + u3m_bail(c3__foul); + } + else { + if ( _(u3a_is_pom(dog)) ) { + u3a_cell* dog_u = (void*)box_u; + u3_noun h_dog = dog_u->hed; + u3_noun t_dog = dog_u->tel; + + if ( !_(u3a_is_cat(h_dog)) ) { + _me_lose_south(h_dog); + } + u3a_cfree((c3_w*)dog_u); + if ( !_(u3a_is_cat(t_dog)) ) { + dog = t_dog; + goto top; + } + } + else { + u3a_wfree(box_u); + } + } + } + } +} + +/* u3a_gain(): gain a reference count in normal space. +*/ +u3_noun +u3a_gain(u3_noun som) +{ + u3t_on(mal_o); + u3_assert(u3_none != som); + + if ( !_(u3a_is_cat(som)) ) { + som = _(u3a_is_north(u3R)) + ? _me_gain_north(som) + : _me_gain_south(som); + } + u3t_off(mal_o); + + return som; +} + +/* u3a_lose(): lose a reference count. +*/ +void +u3a_lose(u3_noun som) +{ + u3t_on(mal_o); + if ( !_(u3a_is_cat(som)) ) { + if ( _(u3a_is_north(u3R)) ) { + _me_lose_north(som); + } else { + _me_lose_south(som); + } + } + u3t_off(mal_o); +} + +/* u3a_use(): reference count. +*/ +c3_w +u3a_use(u3_noun som) +{ + if ( _(u3a_is_cat(som)) ) { + return 1; + } + else { + u3a_noun* box_u = u3a_to_ptr(som); + return box_u->use_w; + } +} + +#define SWAP(l, r) \ + do { typeof(l) t = l; l = r; r = t; } while (0) + +/* _ca_wed_our(): unify [a] and [b] on u3R. +*/ +static inline c3_o +_ca_wed_our(u3_noun *restrict a, u3_noun *restrict b) +{ + c3_t asr_t = ( c3y == u3a_is_senior(u3R, *a) ); + c3_t bsr_t = ( c3y == u3a_is_senior(u3R, *b) ); + + if ( asr_t == bsr_t ) { + // both [a] and [b] are senior; we can't unify on u3R + // + if ( asr_t ) return c3n; + + // both are on u3R; keep the deeper address + // (and gain a reference) + // + // (N && <) || (S && >) + // XX consider keeping higher refcount instead + // + if ( (*a > *b) == (c3y == u3a_is_north(u3R)) ) SWAP(a, b); + + _me_gain_use(*a); + } + // one of [a] or [b] are senior; keep it + // + else if ( !asr_t ) SWAP(a, b); + + u3z(*b); + *b = *a; + return c3y; +} + +/* _ca_wed_you(): unify [a] and [b] on senior [rod_u]. leaks +*/ +static c3_o +_ca_wed_you(u3a_road* rod_u, u3_noun *restrict a, u3_noun *restrict b) +{ + // XX assume( rod_u != u3R ) + c3_t asr_t = ( c3y == u3a_is_senior(rod_u, *a) ); + c3_t bsr_t = ( c3y == u3a_is_senior(rod_u, *b) ); + + if ( asr_t == bsr_t ) { + // both [a] and [b] are senior; we can't unify on [rod_u] + // + if ( asr_t ) return c3n; + + // both are on [rod_u]; keep the deeper address + // (and gain a reference) + // + // (N && <) || (S && >) + // XX consider keeping higher refcount instead + // + if ( (*a > *b) == (c3y == u3a_is_north(rod_u)) ) SWAP(a, b); + + _me_gain_use(*a); + } + // one of [a] or [b] are senior; keep it + // + else if ( !asr_t ) SWAP(a, b); + + *b = *a; + return c3y; +} + +#undef SWAP + +/* u3a_wed(): unify noun references. +*/ +void +u3a_wed(u3_noun *restrict a, u3_noun *restrict b) +{ + // XX assume( *a != *b ) + u3_road* rod_u = u3R; + c3_o wed_o; + + if ( rod_u->kid_p ) return; + + wed_o = _ca_wed_our(a, b); + +#ifdef U3_MEMORY_DEBUG + return; +#else + if ( u3C.wag_w & u3o_debug_ram ) return; +#endif + + // while not at home, attempt to unify + // + // we try to unify on our road, and retry on senior roads + // until we succeed or reach the home road. + // + // we can't perform this kind of butchery on the home road, + // where asynchronous things can allocate. + // (XX anything besides u3t_samp?) + // + // when unifying on a higher road, we can't free nouns, + // because we can't track junior nouns that point into + // that road. + // + // this is just an implementation issue -- we could set use + // counts to 0 without actually freeing. but the allocator + // would have to be actually designed for this. + // (alternately, we could keep a deferred free-list) + // + // not freeing may generate spurious leaks, so we disable + // senior unification when debugging memory. this will + // cause a very slow boot process as the compiler compiles + // itself, constantly running into duplicates. + // + + while ( (c3n == wed_o) + && rod_u->par_p + && (&u3H->rod_u != (rod_u = u3to(u3_road, rod_u->par_p))) ) + { + wed_o = _ca_wed_you(rod_u, a, b); + } +} + +/* u3a_luse(): check refcount sanity. +*/ +void +u3a_luse(u3_noun som) +{ + if ( 0 == u3a_use(som) ) { + fprintf(stderr, "loom: insane %d 0x%x\r\n", som, som); + abort(); + } + if ( _(u3du(som)) ) { + u3a_luse(u3h(som)); + u3a_luse(u3t(som)); + } +} + +/* u3a_mark_ptr(): mark a pointer for gc. Produce size if first mark. +*/ +c3_w +u3a_mark_ptr(void* ptr_v) +{ + // XX restore loom-bounds check + u3_post som_p = u3a_outa(ptr_v); + c3_w siz_w = !(u3C.wag_w & u3o_debug_ram) + ? _mark_post(som_p) + : _count_post(som_p, 0); + + return siz_w; +} + +/* u3a_relocate_post(): replace post with relocation pointer (unchecked). +*/ +void +u3a_relocate_post(u3_post *som_p) +{ + *som_p = _pack_relocate(*som_p); +} + +/* u3a_mark_relocate_post(): replace post with relocation pointer (checked). +*/ +u3_post +u3a_mark_relocate_post(u3_post som_p, c3_t *fir_t) +{ + return _pack_relocate_mark(som_p, fir_t); +} + +/* u3a_relocate_noun(): replace noun with relocation reference, recursively. +*/ +void +u3a_relocate_noun(u3_noun *som) +{ + u3_post old_p, new_p; + u3_noun old; + u3a_cell* cel_u; + c3_t fir_t; + + while ( 1 ) { + old = *som; + + if ( c3y == u3a_is_cat(old) ) return; + + old_p = u3a_to_off(old); + + if ( c3n == u3a_is_cell(old) ) { + new_p = _pack_relocate(old_p); + *som = u3a_to_pug(new_p); + return; + } + + new_p = _pack_relocate_mark(old_p, &fir_t); + *som = u3a_to_pom(new_p); + + if ( !fir_t ) return; + + cel_u = u3to(u3a_cell, old_p); + u3a_relocate_noun(&(cel_u->hed)); + som = &(cel_u->tel); + } +} + +/* u3a_mark_mptr(): mark a malloc-allocated ptr for gc. +*/ +c3_w +u3a_mark_mptr(void* ptr_v) +{ + return u3a_mark_ptr(ptr_v); +} + +/* u3a_mark_rptr(): mark a refcounted, word-aligned ptr for gc. +*/ +c3_w +u3a_mark_rptr(void* ptr_v) +{ + u3_post som_p = u3a_outa(ptr_v); + c3_w siz_w = !(u3C.wag_w & u3o_debug_ram) + ? _mark_post(som_p) + : _count_post(som_p, 1); + + return siz_w; +} + +/* u3a_mark_noun(): mark a noun for gc. Produce size. +*/ +c3_w +u3a_mark_noun(u3_noun som) +{ + c3_w siz_w = 0; + + while ( 1 ) { + if ( _(u3a_is_senior(u3R, som)) ) { + return siz_w; + } + else { + c3_w* dog_w = u3a_to_ptr(som); + c3_w new_w = u3a_mark_rptr(dog_w); + + if ( 0 == new_w || 0xffffffff == new_w ) { // see u3a_mark_ptr() + return siz_w; + } + else { + siz_w += new_w; + if ( _(u3du(som)) ) { + siz_w += u3a_mark_noun(u3h(som)); + som = u3t(som); + } + else return siz_w; + } + } + } +} + +/* u3a_count_noun(): count size of pointer. +*/ +c3_w +u3a_count_ptr(void* ptr_v) +{ +#if 0 + if ( _(u3a_is_north(u3R)) ) { + if ( !((ptr_v >= u3a_into(u3R->rut_p)) && + (ptr_v < u3a_into(u3R->hat_p))) ) + { + return 0; + } + } + else { + if ( !((ptr_v >= u3a_into(u3R->hat_p)) && + (ptr_v < u3a_into(u3R->rut_p))) ) + { + return 0; + } + } + { + u3a_box* box_u = u3a_botox(ptr_v); + c3_w siz_w; + + c3_ws use_ws = (c3_ws)box_u->use_w; + + if ( use_ws == 0 ) { + fprintf(stderr, "%p is bogus\r\n", ptr_v); + siz_w = 0; + } + else { + u3_assert(use_ws != 0); + + if ( use_ws < 0 ) { + siz_w = 0; + } + else { + use_ws = -use_ws; + siz_w = box_u->siz_w; + } + box_u->use_w = (c3_w)use_ws; + } + return siz_w; + } +#endif + return 0; +} + +/* u3a_count_noun(): count size of noun. +*/ +c3_w +u3a_count_noun(u3_noun som) +{ + c3_w siz_w = 0; + + while ( 1 ) { + if ( _(u3a_is_senior(u3R, som)) ) { + return siz_w; + } + else { + c3_w* dog_w = u3a_to_ptr(som); + c3_w new_w = u3a_count_ptr(dog_w); + + if ( 0 == new_w ) { + return siz_w; + } + else { + siz_w += new_w; + if ( _(u3du(som)) ) { + siz_w += u3a_count_noun(u3h(som)); + som = u3t(som); + } + else return siz_w; + } + } + } +} + +/* u3a_discount_ptr(): clean up after counting a pointer. +*/ +c3_w +u3a_discount_ptr(void* ptr_v) +{ +#if 0 + if ( _(u3a_is_north(u3R)) ) { + if ( !((ptr_v >= u3a_into(u3R->rut_p)) && + (ptr_v < u3a_into(u3R->hat_p))) ) + { + return 0; + } + } + else { + if ( !((ptr_v >= u3a_into(u3R->hat_p)) && + (ptr_v < u3a_into(u3R->rut_p))) ) + { + return 0; + } + } + u3a_box* box_u = u3a_botox(ptr_v); + c3_w siz_w; + + c3_ws use_ws = (c3_ws)box_u->use_w; + + if ( use_ws == 0 ) { + fprintf(stderr, "%p is bogus\r\n", ptr_v); + siz_w = 0; + } + else { + u3_assert(use_ws != 0); + + if ( use_ws < 0 ) { + use_ws = -use_ws; + siz_w = box_u->siz_w; + } + else { + siz_w = 0; + } + box_u->use_w = (c3_w)use_ws; + } + + return siz_w; +#endif + return 0; +} + +/* u3a_discount_noun(): clean up after counting a noun. +*/ +c3_w +u3a_discount_noun(u3_noun som) +{ + c3_w siz_w = 0; + + while ( 1 ) { + if ( _(u3a_is_senior(u3R, som)) ) { + return siz_w; + } + else { + c3_w* dog_w = u3a_to_ptr(som); + c3_w new_w = u3a_discount_ptr(dog_w); + + if ( 0 == new_w ) { + return siz_w; + } + else { + siz_w += new_w; + if ( _(u3du(som)) ) { + siz_w += u3a_discount_noun(u3h(som)); + som = u3t(som); + } + else return siz_w; + } + } + } +} + +/* u3a_print_time: print microsecond time. +*/ +void +u3a_print_time(c3_c* str_c, c3_c* cap_c, c3_d mic_d) +{ + u3_assert( 0 != str_c ); + + c3_w sec_w = (mic_d / 1000000); + c3_w mec_w = (mic_d % 1000000) / 1000; + c3_w mic_w = (mic_d % 1000); + + if ( sec_w ) { + sprintf(str_c, "%s s/%d.%03d.%03d", cap_c, sec_w, mec_w, mic_w); + } + else if ( mec_w ) { + sprintf(str_c, "%s ms/%d.%03d", cap_c, mec_w, mic_w); + } + else { + sprintf(str_c, "%s \xc2\xb5s/%d", cap_c, mic_w); + } +} + +/* u3a_print_memory: print memory amount to file descriptor. +*/ +void +u3a_print_memory(FILE* fil_u, c3_c* cap_c, c3_w wor_w) +{ + u3_assert( 0 != fil_u ); + + c3_z byt_z = ((c3_z)wor_w * 4); + c3_z gib_z = (byt_z / 1000000000); + c3_z mib_z = (byt_z % 1000000000) / 1000000; + c3_z kib_z = (byt_z % 1000000) / 1000; + c3_z bib_z = (byt_z % 1000); + + if ( byt_z ) { + if ( gib_z ) { + fprintf(fil_u, "%s: GB/%" PRIc3_z ".%03" PRIc3_z ".%03" PRIc3_z ".%03" PRIc3_z "\r\n", + cap_c, gib_z, mib_z, kib_z, bib_z); + } + else if ( mib_z ) { + fprintf(fil_u, "%s: MB/%" PRIc3_z ".%03" PRIc3_z ".%03" PRIc3_z "\r\n", + cap_c, mib_z, kib_z, bib_z); + } + else if ( kib_z ) { + fprintf(fil_u, "%s: KB/%" PRIc3_z ".%03" PRIc3_z "\r\n", + cap_c, kib_z, bib_z); + } + else if ( bib_z ) { + fprintf(fil_u, "%s: B/%" PRIc3_z "\r\n", + cap_c, bib_z); + } + } +} + +/* u3a_print_memory_str: print memory amount to string. +*/ +void +u3a_print_memory_str(c3_c* str_c, c3_c* cap_c, c3_w wor_w) +{ + u3_assert( 0 != str_c ); + + c3_z byt_z = ((c3_z)wor_w * 4); + c3_z gib_z = (byt_z / 1000000000); + c3_z mib_z = (byt_z % 1000000000) / 1000000; + c3_z kib_z = (byt_z % 1000000) / 1000; + c3_z bib_z = (byt_z % 1000); + + if ( byt_z ) { + if ( gib_z ) { + sprintf(str_c, "%s: GB/%" PRIc3_z ".%03" PRIc3_z ".%03" PRIc3_z ".%03" PRIc3_z "\r\n", + cap_c, gib_z, mib_z, kib_z, bib_z); + } + else if ( mib_z ) { + sprintf(str_c, "%s: MB/%" PRIc3_z ".%03" PRIc3_z ".%03" PRIc3_z "\r\n", + cap_c, mib_z, kib_z, bib_z); + } + else if ( kib_z ) { + sprintf(str_c, "%s: KB/%" PRIc3_z ".%03" PRIc3_z "\r\n", + cap_c, kib_z, bib_z); + } + else if ( bib_z ) { + sprintf(str_c, "%s: B/%" PRIc3_z "\r\n", + cap_c, bib_z); + } + } +} + +/* u3a_maid(): maybe print memory. +*/ +c3_w +u3a_maid(FILE* fil_u, c3_c* cap_c, c3_w wor_w) +{ + if ( 0 != fil_u ) { + u3a_print_memory(fil_u, cap_c, wor_w); + } + return wor_w; +} + +/* _ca_print_memory(): un-captioned u3a_print_memory(). +*/ +static void +_ca_print_memory(FILE* fil_u, c3_w byt_w) +{ + c3_w gib_w = (byt_w / 1000000000); + c3_w mib_w = (byt_w % 1000000000) / 1000000; + c3_w kib_w = (byt_w % 1000000) / 1000; + c3_w bib_w = (byt_w % 1000); + + if ( gib_w ) { + fprintf(fil_u, "GB/%d.%03d.%03d.%03d\r\n", + gib_w, mib_w, kib_w, bib_w); + } + else if ( mib_w ) { + fprintf(fil_u, "MB/%d.%03d.%03d\r\n", mib_w, kib_w, bib_w); + } + else if ( kib_w ) { + fprintf(fil_u, "KB/%d.%03d\r\n", kib_w, bib_w); + } + else { + fprintf(fil_u, "B/%d\r\n", bib_w); + } +} + +/* u3a_quac_free: free quac memory. +*/ +void +u3a_quac_free(u3m_quac* qua_u) +{ + c3_w i_w = 0; + while ( qua_u->qua_u[i_w] != NULL ) { + u3a_quac_free(qua_u->qua_u[i_w]); + i_w++; + } + c3_free(qua_u->nam_c); + c3_free(qua_u->qua_u); + c3_free(qua_u); +} + +static c3_w +_ca_prof_mark(u3_noun som) +{ + if ( c3y == u3a_is_senior(u3R, som) ) { + return 0; + } + + // marking memory-profile entries under u3o_debug_ram + // requires special care to avoid over-incrementing the refcount, + // as the entries in the profile are not true roots: + // they either belong to arvo or the profile itself. + // we measure them here, but account for them elsewhere (subsequently) + // from a refcounting standpoint + // + u3_post som_p = u3a_to_off(som); + c3_w siz_w = !(u3C.wag_w & u3o_debug_ram) + ? _mark_post(som_p) + : _count_post(som_p, 2); + + if ( !siz_w ) { + return 0; + } + + if ( c3y == u3a_is_cell(som) ) { + siz_w += u3a_mark_noun(u3h(som)); + siz_w += u3a_mark_noun(u3t(som)); + } + + return siz_w; +} + +/* u3a_prof(): mark/measure/print memory profile. RETAIN. +*/ +u3m_quac* +u3a_prof(FILE* fil_u, u3_noun mas) +{ + u3m_quac* pro_u = c3_calloc(sizeof(*pro_u)); + u3_noun h_mas, t_mas; + + if ( c3n == u3r_cell(mas, &h_mas, &t_mas) ) { + fprintf(fil_u, "mistyped mass\r\n"); + c3_free(pro_u); + return NULL; + } + else if ( c3y == u3du(h_mas) ) { + fprintf(fil_u, "mistyped mass head\r\n"); + { + c3_c* lab_c = u3m_pretty(h_mas); + fprintf(fil_u, "h_mas: %s", lab_c); + c3_free(lab_c); + } + c3_free(pro_u); + return NULL; + } + else { + + u3_noun it_mas, tt_mas; + + if ( c3n == u3r_cell(t_mas, &it_mas, &tt_mas) ) { + fprintf(fil_u, "mistyped mass tail\r\n"); + c3_free(pro_u); + return NULL; + } + else if ( c3y == it_mas ) { + c3_w siz_w = _ca_prof_mark(tt_mas); + + pro_u->nam_c = u3r_string(h_mas); + pro_u->siz_w = siz_w*4; + pro_u->qua_u = NULL; + return pro_u; + + } + else if ( c3n == it_mas ) { + pro_u->qua_u = c3_malloc(sizeof(pro_u->qua_u)); + c3_w i_w = 0; + c3_t bad_t = 0; + while ( c3y == u3du(tt_mas) ) { + u3m_quac* new_u = u3a_prof(fil_u, u3h(tt_mas)); + if ( NULL == new_u ) { + bad_t = 1; + } else { + pro_u->qua_u = c3_realloc(pro_u->qua_u, (i_w + 2) * sizeof(pro_u->qua_u)); + pro_u->siz_w += new_u->siz_w; + pro_u->qua_u[i_w] = new_u; + } + tt_mas = u3t(tt_mas); + i_w++; + } + pro_u->qua_u[i_w] = NULL; + + if ( bad_t ) { + i_w = 0; + while ( pro_u->qua_u[i_w] != NULL ) { + u3a_quac_free(pro_u->qua_u[i_w]); + i_w++; + } + c3_free(pro_u->qua_u); + c3_free(pro_u); + return NULL; + } else { + pro_u->nam_c = u3r_string(h_mas); + return pro_u; + } + } + else { + fprintf(fil_u, "mistyped (strange) mass tail\r\n"); + c3_free(pro_u); + return NULL; + } + } +} + + +/* u3a_print_quac: print a memory report. +*/ + +void +u3a_print_quac(FILE* fil_u, c3_w den_w, u3m_quac* mas_u) +{ + u3_assert( 0 != fil_u ); + + if ( mas_u->siz_w ) { + fprintf(fil_u, "%*s%s: ", den_w, "", mas_u->nam_c); + + if ( mas_u->qua_u == NULL ) { + _ca_print_memory(fil_u, mas_u->siz_w); + } else { + fprintf(fil_u, "\r\n"); + c3_w i_w = 0; + while ( mas_u->qua_u[i_w] != NULL ) { + u3a_print_quac(fil_u, den_w+2, mas_u->qua_u[i_w]); + i_w++; + } + fprintf(fil_u, "%*s--", den_w, ""); + _ca_print_memory(fil_u, mas_u->siz_w); + } + } +} + +/* u3a_mark_road(): mark ad-hoc persistent road structures. +*/ +u3m_quac* +u3a_mark_road() +{ + u3m_quac** qua_u = c3_malloc(sizeof(*qua_u) * 14); + + qua_u[0] = c3_calloc(sizeof(*qua_u[0])); + qua_u[0]->nam_c = strdup("namespace"); + qua_u[0]->siz_w = u3a_mark_noun(u3R->ski.gul) * 4; + + qua_u[1] = c3_calloc(sizeof(*qua_u[1])); + qua_u[1]->nam_c = strdup("trace stack"); + qua_u[1]->siz_w = u3a_mark_noun(u3R->bug.tax) * 4; + + qua_u[2] = c3_calloc(sizeof(*qua_u[2])); + qua_u[2]->nam_c = strdup("trace buffer"); + qua_u[2]->siz_w = u3a_mark_noun(u3R->bug.mer) * 4; + + qua_u[3] = c3_calloc(sizeof(*qua_u[3])); + qua_u[3]->nam_c = strdup("profile batteries"); + qua_u[3]->siz_w = u3a_mark_noun(u3R->pro.don) * 4; + + qua_u[4] = c3_calloc(sizeof(*qua_u[4])); + qua_u[4]->nam_c = strdup("profile doss"); + qua_u[4]->siz_w = u3a_mark_noun(u3R->pro.day) * 4; + + qua_u[5] = c3_calloc(sizeof(*qua_u[5])); + qua_u[5]->nam_c = strdup("new profile trace"); + qua_u[5]->siz_w = u3a_mark_noun(u3R->pro.trace) * 4; + + qua_u[6] = c3_calloc(sizeof(*qua_u[6])); + qua_u[6]->nam_c = strdup("transient memoization cache"); + qua_u[6]->siz_w = u3h_mark(u3R->cax.har_p) * 4; + + qua_u[7] = c3_calloc(sizeof(*qua_u[7])); + qua_u[7]->nam_c = strdup("persistent memoization cache"); + qua_u[7]->siz_w = u3h_mark(u3R->cax.per_p) * 4; + + qua_u[8] = c3_calloc(sizeof(*qua_u[8])); + qua_u[8]->nam_c = strdup("page directory"); + qua_u[8]->siz_w = u3a_mark_ptr(u3a_into(u3R->hep.pag_p)) * 4; + + qua_u[9] = c3_calloc(sizeof(*qua_u[9])); + qua_u[9]->nam_c = strdup("cell pool"); + + { + u3_post *cel_p; + c3_w cel_w = 0; + + if ( u3R->cel.cel_p ) { + cel_p = u3to(u3_post, u3R->cel.cel_p); + cel_w += u3a_mark_ptr(cel_p); + + for ( c3_w i_w = 0; i_w < u3R->cel.hav_w; i_w++ ) { + cel_w += u3a_mark_ptr(u3a_into(cel_p[i_w])); + } + } + + qua_u[9]->siz_w = cel_w * 4; + } + + qua_u[10] = c3_calloc(sizeof(*qua_u[10])); + qua_u[10]->nam_c = strdup("free list"); + + { + u3a_dell *fre_u = u3tn(u3a_dell, u3R->hep.fre_p); + c3_w fre_w = 0; + + while ( fre_u ) { + fre_w += u3a_mark_ptr(fre_u); + fre_u = u3tn(u3a_dell, fre_u->nex_p); + } + + if ( u3R->hep.cac_p ) { + fre_w += u3a_mark_ptr(u3a_into(u3R->hep.cac_p)); + } + + qua_u[10]->siz_w = fre_w * 4; + } + + qua_u[11] = c3_calloc(sizeof(*qua_u[11])); + qua_u[11]->nam_c = strdup("metadata"); + + { + c3_w wee_w = 0; + + for ( c3_w i_w = 0; i_w < u3a_crag_no; i_w++ ) { + wee_w += u3a_Mark.wee_w[i_w]; + } + + qua_u[11]->siz_w = wee_w * 4; + } + + qua_u[12] = NULL; + + c3_w sum_w = 0; + for (c3_w i_w = 0; qua_u[i_w]; i_w++) { + sum_w += qua_u[i_w]->siz_w; + } + + u3m_quac* tot_u = c3_malloc(sizeof(*tot_u)); + tot_u->nam_c = strdup("total road stuff"); + tot_u->siz_w = sum_w; + tot_u->qua_u = qua_u; + + return tot_u; +} + +/* u3a_reclaim(): clear ad-hoc persistent caches to reclaim memory. +*/ +void +u3a_reclaim(void) +{ + // clear the memoization cache + // + u3h_free(u3R->cax.har_p); + u3R->cax.har_p = u3h_new(); +} + +/* u3a_rewrite_compact(): rewrite pointers in ad-hoc persistent road structures. +*/ +void +u3a_rewrite_compact(void) +{ + // XX relocate cel_p + u3a_relocate_noun(&(u3R->ski.gul)); + u3a_relocate_noun(&(u3R->bug.tax)); + u3a_relocate_noun(&(u3R->bug.mer)); + u3a_relocate_noun(&(u3R->pro.don)); + u3a_relocate_noun(&(u3R->pro.day)); + u3a_relocate_noun(&(u3R->pro.trace)); + u3h_relocate(&(u3R->cax.har_p)); + u3h_relocate(&(u3R->cax.per_p)); +} + +/* u3a_idle(): measure free-lists in [rod_u] +*/ +c3_w +u3a_idle(u3a_road* rod_u) +{ + // XX ignores argument + c3_w pag_w = _idle_pages(); + if ( pag_w ) { + fprintf(stderr, "loom: idle %u complete pages\r\n", pag_w); + } + return (pag_w << u3a_page) + _idle_words(); +} + +void +u3a_ream(void) +{ + _poison_pages(); + _poison_words(); +} + +void +u3a_wait(void) +{ + _unpoison_words(); +} + +void +u3a_dash(void) +{ + _poison_words(); +} + +/* u3a_sweep(): sweep a fully marked road. +*/ +c3_w +u3a_sweep(void) +{ + c3_w siz_w = !(u3C.wag_w & u3o_debug_ram) + ? _sweep_directory() + : _sweep_counts(); + + return siz_w; +} + +/* u3a_pack_seek(): sweep the heap, modifying boxes to record new addresses. +*/ +void +u3a_pack_seek(u3a_road* rod_u) +{ + u3a_pack_init(); + + // XX clear cell pool on inner roads? + + // XX use road argument + _pack_seek(); + _pack_relocate_heap(); +} + +/* u3a_pack_move(): sweep the heap, moving boxes to new addresses. +*/ +void +u3a_pack_move(u3a_road* rod_u) +{ + // XX use road argument + _pack_move(); + + u3a_pack_done(); + + u3_post old_p = u3R->hat_p; + + // XX move me? + // + u3R->hat_p = u3R->rut_p + (u3R->hep.dir_ws * (c3_ws)(u3R->hep.len_w << u3a_page)); + + u3a_drop_heap(old_p, u3R->hat_p); +} + +#if 0 +/* _ca_detect(): in u3a_detect(). +*/ +static c3_d +_ca_detect(u3p(u3h_root) har_p, u3_noun fum, u3_noun som, c3_d axe_d) +{ + while ( 1 ) { + if ( som == fum ) { + return axe_d; + } + else if ( !_(u3du(fum)) || (u3_none != u3h_get(har_p, fum)) ) { + return 0; + } + else { + c3_d eax_d; + + u3h_put(har_p, fum, 0); + + if ( 0 != (eax_d = _ca_detect(har_p, u3h(fum), som, 2ULL * axe_d)) ) { + return c3y; + } + else { + fum = u3t(fum); + axe_d = (2ULL * axe_d) + 1; + } + } + } +} + +/* u3a_detect(): for debugging, check if (som) is referenced from (fum). +** +** (som) and (fum) are both RETAINED. +*/ +c3_d +u3a_detect(u3_noun fum, u3_noun som) +{ + u3p(u3h_root) har_p = u3h_new(); + c3_o ret_o; + + ret_o = _ca_detect(har_p, fum, som, 1); + u3h_free(har_p); + + return ret_o; +} +#endif + +#ifdef U3_MEMORY_DEBUG +/* u3a_lush(): leak push. +*/ +c3_w +u3a_lush(c3_w lab_w) +{ + c3_w cod_w = u3_Code; + + u3_Code = lab_w; + return cod_w; +} + +/* u3a_lop(): leak pop. +*/ +void +u3a_lop(c3_w lab_w) +{ + u3_Code = lab_w; +} +#else +/* u3a_lush(): leak push. +*/ +c3_w +u3a_lush(c3_w lab_w) +{ + return 0; +} + +/* u3a_lop(): leak pop. +*/ +void +u3a_lop(c3_w lab_w) +{ +} +#endif + +/* u3a_walk_fore(): preorder traversal, visits ever limb of a noun. +** +** cells are visited *before* their heads and tails +** and can shortcircuit traversal by returning [c3n] +*/ +void +u3a_walk_fore(u3_noun a, + void* ptr_v, + void (*pat_f)(u3_atom, void*), + c3_o (*cel_f)(u3_noun, void*)) +{ + u3_noun* top; + u3a_pile pil_u; + + // initialize stack control; push argument + // + u3a_pile_prep(&pil_u, sizeof(u3_noun)); + top = u3a_push(&pil_u); + *top = a; + + while ( c3n == u3a_pile_done(&pil_u) ) { + // visit an atom, then pop the stack + // + if ( c3y == u3a_is_atom(a) ) { + pat_f(a, ptr_v); + top = u3a_pop(&pil_u); + } + // vist a cell, if c3n, pop the stack + // + else if ( c3n == cel_f(a, ptr_v) ) { + top = u3a_pop(&pil_u); + } + // otherwise, push the tail and continue into the head + // + else { + *top = u3t(a); + top = u3a_push(&pil_u); + *top = u3h(a); + } + + a = *top; + } +} + +/* u3a_string(): `a` as an on-loom c-string. +*/ +c3_c* +u3a_string(u3_atom a) +{ + c3_w met_w = u3r_met(3, a); + c3_c* str_c = u3a_malloc(met_w + 1); + + u3r_bytes(0, met_w, (c3_y*)str_c, a); + str_c[met_w] = 0; + return str_c; +} + +/* u3a_loom_sane(): sanity checks the state of the loom for obvious corruption + */ +void +u3a_loom_sane(void) +{ +} |