/* include/meme.h ** ** This file is in the public domain. */ /** Subordinate includes. **/ /** c3: the C layer. **/ # include "c/portable.h" # include "c/tune.h" # include "c/types.h" # include "c/defs.h" # include "c/motes.h" # include "c/comd.h" /** Tuning and configuration. **/ # define u2_me_fbox_no 28 # undef U2_MEMORY_DEBUG # ifdef U2_MEMORY_DEBUG # define u2_leak_on(x) (COD_w = x) extern c3_w COD_w; # define u2_leak_off (COD_w = 0) # endif /** Data structures. **/ /* u2_noun: tagged pointer. ** ** If bit 31 is 0, a u2_noun is a direct 31-bit atom ("cat"). ** If bit 31 is 1 and bit 30 0, an indirect atom ("pug"). ** If bit 31 is 1 and bit 30 1, an indirect cell ("pom"). ** ** Bits 0-29 are a word offset against u2_Loom. */ typedef c3_w u2_noun; /* u2_none - out-of-band noun. */ # define u2_none (u2_noun)0xffffffff /* u2_atom, u2_cell: logical atom and cell structures. */ typedef struct { c3_w mug_w; } u2_me_noun; typedef struct { c3_w mug_w; c3_w len_w; c3_w buf_w[0]; } u2_me_atom; typedef struct _u2_loom_cell { c3_w mug_w; u2_noun hed; u2_noun tel; } u2_me_cell; /* u2_yes, u2_no, u2_nul; ** ** Our Martian booleans and list terminator; empty string; not a nonu. */ # define u2_yes 0 # define u2_no 1 # define u2_nul 0 # define u2_blip 0 /* Tools for Martian booleans. */ # define u2_so(x) (u2_yes == (x)) # define u2_ne(x) (u2_no == (x)) # define u2_say(x) ( (x) ? u2_yes : u2_no ) # define u2_not(x) ( (x == u2_yes) ? u2_no : u2_yes ) # define u2_and(x, y) ( (u2_so(x) && u2_so(y)) ? u2_yes : u2_no ) # define u2_or(x, y) ( (u2_so(x) || u2_so(y)) ? u2_yes : u2_no ) /* Inside a noun. */ # define u2_me_is_cat(som) (((som) >> 31) ? u2_no : u2_yes) # define u2_me_is_dog(som) (((som) >> 31) ? u2_yes : u2_no) # define u2_me_is_pug(som) (2 == (som >> 30)) # define u2_me_is_pom(som) (3 == (som >> 30)) # define u2_me_to_ptr(som) ((void *)(u2_me_into(som & 0x3fffffff))) # define u2_me_is_atom(som) u2_or(u2_noun_is_cat(som), \ u2_noun_is_pug(som)) # define u2_me_is_cell(som) u2_noun_is_pom(som) # define u2_me_de_twin(dog, dog_w) ((dog & 0xc0000000) | u2_me_outa(dog_w)) /* More typedefs. */ typedef u2_noun u2_atom; // must be atom typedef u2_noun u2_term; // @tas typedef u2_noun u2_mote; // @tas typedef u2_noun u2_cell; // must be cell typedef u2_noun u2_trel; // must be triple typedef u2_noun u2_qual; // must be quadruple typedef u2_noun u2_quin; // must be quintuple typedef u2_noun u2_bean; // loobean: 0 == u2_yes, 1 == u2_no typedef u2_noun u2_weak; // may be u2_none /* u2_me_box: classic allocation box. ** ** The box size is also stored at the end of the box in classic ** bad ass malloc style. Hence a box is: ** ** --- ** siz_w ** use_w ** if(debug) cod_w ** user data ** siz_w ** --- ** ** Do not attempt to adjust this structure! */ typedef struct _u2_me_box { c3_w siz_w; // size of this box c3_w use_w; // reference count; free if 0 # ifdef U2_MEMORY_DEBUG c3_w cod_w; // tracing code # endif } u2_me_box; # define u2_me_boxed(len_w) (len_w + c3_wiseof(u2_me_box) + 1) # define u2_me_boxto(box_v) ( (void *) \ ( ((c3_w *)(void*)(box_v)) + \ c3_wiseof(u2_me_box) ) ) # define u2_me_botox(tox_v) ( (struct _u2_me_box *) \ (void *) \ ( ((c3_w *)(void*)(tox_v)) - \ c3_wiseof(u2_me_box) ) ) /* u2_me_fbox: free node in heap. Sets minimum node size. ** */ typedef struct _u2_me_fbox { u2_me_box box_u; struct _u2_me_fbox* pre_u; struct _u2_me_fbox* nex_u; } u2_me_fbox; # define u2_me_minimum (c3_wiseof(u2_me_fbox)) /* u2_me_road: contiguous allocation and execution context. ** ** The road can point in either direction. If cap > hat, it ** looks like this ("north"): ** ** 0 rut hat ffff ** | | | | ** |~~~~~~~~~~~~-------##########################+++++++$~~~~~| ** | | | | ** 0 cap mat ffff ** ** Otherwise, it looks like this ("south"): ** ** 0 mat cap ffff ** | | | | ** |~~~~~~~~~~~~$++++++##########################--------~~~~~| ** | | | | ** 0 hat rut ffff ** ** Legend: - is durable storage (heap); + is temporary storage ** (stack); ~ is deep storage (immutable); $ is the allocation block; ** # is free memory. ** ** Pointer restrictions: pointers stored in + can point anywhere, ** except to more central pointers in +. (Ie, all pointers from ** stack to stack must point downward on the stack.) Pointers in ** - can only point to - or ~; pointers in ~ only point to ~. ** ** To "leap" is to create a new inner road in the ### free space. ** but in the reverse direction, so that when the inner road ** "falls" (terminates), its durable storage is left on the ** temporary storage of the outer road. ** ** In all cases, the pointer in a u2_noun is a word offset into ** u2H, the top-level road. */ typedef struct _u2_me_road { struct _u2_me_road* par_u; // parent road struct _u2_me_road* kid_u; // child road list struct _u2_me_road* nex_u; // sibling road c3_w* cap_w; // top of transient region c3_w* hat_w; // top of durable region c3_w* mat_w; // bottom of transient region c3_w* rut_w; // bottom of durable region #if 0 c3_w* gar_w; // bottom of guard region (future) c3_w* rag_w; // top of guard region (future) c3_w pad_w[4]; // future interesting info #endif struct { // escape buffer union { jmp_buf buf; c3_w buf_w[256]; // futureproofing }; } esc; struct { // allocation pools u2_me_fbox* fre_u[u2_me_fbox_no]; // heap by node size log # ifdef U2_MEMORY_DEBUG c3_w liv_w; // number of live words # endif } all; struct { // jet dashboard u2_noun dax; // (map ,* (list chub)) } jed; struct { // namespace u2_noun fly; // $+(* (unit)) } ski; struct { // need state u2_noun nyd; // (list path) } nyd; struct { // trace stack u2_noun tax; // (list ,*) } bug; struct { // profiling stack u2_noun don; // (list ,*) } pro; struct { // memoization u2_noun sav; // (map (pair term noun) noun) } cax; } u2_me_road; typedef u2_me_road u2_road; /** Globals. **/ /* u2_Loom: base of loom, as a word pointer. */ c3_global c3_w* u2_Loom; # define u2L u2_Loom; /* u2_Home / u2H: root of thread. Always north. */ c3_global u2_road* u2_Home; # define u2H u2_Home /* u2_Road / u2R: current road (thread-local). */ c3_global u2_road* u2_Road; # define u2R u2_Road /** Macros. **/ # define u2_me_is_north ((u2R->cap_w > u2R->hat_w) ? u2_yes : u2_no) # define u2_me_is_south ((u2_yes == u2_me_is_north) ? u2_no : u2_yes) # define u2_me_open ( (u2_yes == u2_me_is_north) \ ? (c3_w)(u2R->cap_w - u2R->hat_w) \ : (c3_w)(u2R->hat_w - u2R->cap_w) ) # define u2_me_into(x) (u2_Loom + (x)) # define u2_me_outa(p) (((c3_w*)(void*)(p)) - u2_Loom) /** Functions. **/ /* u2_me_boot(): make u2R and u2H from `len` words at `mem`. */ void u2_me_boot(void* mem_v, c3_w len_w); /* u2_me_trap(): setjmp within road. */ #if 0 u2_bean u2_me_trap(void); #else # define u2_me_trap() (u2_bean)(setjmp(u2R->esc.buf)) #endif /* u2_me_bail(): bail out. Does not return. ** ** Bail motes: ** ** %exit :: semantic failure ** %intr :: interrupt ** %fail :: execution failure ** %need :: network block ** %meme :: out of memory */ c3_i u2_me_bail(c3_m how_m); /* u2_me_grab(): garbage-collect memory. Asserts u2R == u2H. */ void u2_me_grab(void); /* u2_me_check(): checkpoint memory to file. Asserts u2R == u2H. */ void u2_me_check(void); /* u2_me_fall(): return to parent road. */ void u2_me_fall(void); /* u2_me_leap(): advance to inner road. */ void u2_me_leap(void); /* u2_me_golf(): record cap length for u2_flog(). */ c3_w u2_me_golf(void); /* u2_me_flog(): pop the cap. ** ** A common sequence for inner allocation is: ** ** c3_w gof_w = u2_me_golf(); ** u2_me_leap(); ** // allocate some inner stuff... ** u2_me_fall(); ** // inner stuff is still valid, but on cap ** u2_me_flog(gof_w); ** ** u2_me_flog(0) simply clears the cap. */ void u2_me_flog(c3_w gof_w); /* u2_me_water(): produce high and low watermarks. Asserts u2R == u2H. */ void u2_me_water(c3_w *low_w, c3_w *hig_w); /** Allocation. **/ /* Basic allocation. */ /* u2_me_walloc(): allocate storage measured in words. */ void* u2_me_walloc(c3_w len_w); /* u2_me_malloc(): allocate storage measured in bytes. */ void* u2_me_malloc(c3_w len_w); /* u2_me_free(): free storage. */ void u2_me_free(void* lag_v); /* Reference and arena control. */ /* u2_me_gain(): gain and/or copy juniors. */ u2_weak u2_me_gain(u2_weak som); /* u2_me_lose(): lose a reference. */ void u2_me_lose(u2_weak som); /* u2_me_junior(): yes iff reference cannot be saved. */ u2_bean u2_me_junior(u2_noun som); /* u2_me_senior(): yes iff references need not be counted. */ u2_bean u2_me_senior(u2_noun som); /* u2_me_refs(): reference count. */ c3_w u2_me_refs(u2_noun som); /* Atoms from proto-atoms. */ /* u2_me_slab(): create a length-bounded proto-atom. */ c3_w* u2_me_slab(c3_w len_w); /* u2_me_slaq(): u2_me_slaq() with a defined blocksize. */ c3_w* u2_me_slaq(c3_g met_g, c3_w len_w); /* u2_me_malt(): measure and finish a proto-atom. */ u2_noun u2_me_malt(c3_w* sal_w); /* u2_me_moot(): finish a pre-measured proto-atom; dangerous. */ u2_noun u2_me_moot(c3_w* sal_w); /* u2_me_mint(): finish a measured proto-atom. */ u2_noun u2_me_mint(c3_w* sal_w, c3_w len_w); /* Garbage collection (for debugging only). */ /* u2_me_mark(): mark for gc, returning allocated words. */ c3_w u2_me_mark(u2_noun som); /* u2_me_sweep(): sweep after gc, freeing, matching live count. */ c3_w u2_me_sweep(c3_w liv_w); /** Generic computation. **/ /* u2_me_nock_on(): produce .*(bus fol). */ u2_noun u2_me_nock_on(u2_noun bus, u2_noun fol); /* u2_me_slam_on(): produce (gat sam). */ u2_noun u2_me_slam_on(u2_noun gat, u2_noun sam); /* u2_me_nock_un(): produce .*(bus fol), as ++toon. */ u2_noun u2_me_nock_un(u2_noun bus, u2_noun fol); /* u2_me_slam_un(): produce (gat sam), as ++toon. */ u2_noun u2_me_slam_un(u2_noun gat, u2_noun sam); /* u2_me_nock_in(): produce .*(bus fol), as ++toon, in namespace. */ u2_noun u2_me_nock_in(u2_noun fly, u2_noun bus, u2_noun fol); /* u2_me_slam_in(): produce (gat sam), as ++toon, in namespace. */ u2_noun u2_me_slam_in(u2_noun fly, u2_noun gat, u2_noun sam); /** Memoization. *** *** The memo cache is keyed by an arbitrary symbolic function *** and a noun argument to that (logical) function. Functions *** are predefined by C-level callers, but 0 means nock. *** *** The memo cache is within its road and dies when it falls. **/ /* u2_me_find*(): find in memo cache. */ u2_weak u2_me_find(u2_mote, u2_noun); u2_weak u2_me_find_2(u2_mote, u2_noun, u2_noun); u2_weak u2_me_find_3(u2_mote, u2_noun, u2_noun, u2_noun); u2_weak u2_me_find_4(u2_mote, u2_noun, u2_noun, u2_noun, u2_noun); /* u2_me_save*(): save in memo cache. */ u2_weak u2_me_save(u2_mote, u2_noun, u2_noun); u2_weak u2_me_save_2(u2_mote, u2_noun, u2_noun, u2_noun); u2_weak u2_me_save_3(u2_mote, u2_noun, u2_noun, u2_noun, u2_noun); u2_weak u2_me_save_4 (u2_mote, u2_noun, u2_noun, u2_noun, u2_noun, u2_noun); /* u2_me_uniq(): uniquify with memo cache. */ u2_weak u2_me_uniq(u2_noun som);