static double aterms(double mya, void *mydata) {
int i, t;
double val = 0;
double la = log(mya);
#ifdef A_DEBUG
float save_a = ddC.SX->a;
double like;
#endif
S_remake(ddC.SX, mya);
for (i=0; i<ddN.DT; i++) {
uint32_t Td_ = 0;
for (t=0; t<ddN.T; t++) {
Td_ += ddS.Tdt[i][t];
if ( ddS.Ndt[i][t]>1 ) {
val += S_S(ddC.SX,ddS.Ndt[i][t],ddS.Tdt[i][t]);
}
}
val += Td_*la + lgamma(ddP.bpar/mya+Td_) - lgamma(ddP.bpar/mya);
}
myarms_evals++;
#ifdef A_DEBUG
yap_message("Eval aterms(%lf) = %lf (S had %f)", mya, val, save_a);
ddP.apar = mya;
cache_update("a");
like = likelihood();
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
}
last_like = like;
last_val = val;
#endif
return val;
}
static double aterms_phi0(double mya, void *mydata) {
int v;
double val = 0;
#ifdef A_DEBUG
float save_a = ddC.a_phi0->a;
double like;
#endif
S_remake(ddC.a_phi0, mya);
val += poch(ddP.b_phi0, mya, ddS.S_0_nz);
for (v=0; v<ddN.W; v++) {
if ( ddS.S_0vT[v]>1 )
val += S_S(ddC.a_phi0, ddS.S_0vT[v], 1);
}
myarms_evals++;
#ifdef A_DEBUG
yap_message("Eval aterms_phi0(%lf) = %lf (S had %f)", mya, val, save_a);
ddP.a_phi0 = mya;
cache_update("ap0");
like = likelihood();
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
}
last_like = like;
last_val = val;
#endif
return val;
}
static double adkterms(double mya, void *mydata) {
double val = 0;
uint16_t **docstats = (uint16_t **)mydata;
#ifdef A_DEBUG
float save_a = ddC.SD->a;
double like;
#endif
ddP.ad = mya;
cache_update("ad");
val = dmi_likelihood_aterms(&ddM, docstats,
pctl_gammaprior, ddP.ad, ddP.bdk, ddC.SD);
myarms_evals++;
#ifdef A_DEBUG
yap_message("Eval adkterms(%lf) = %lf", mya, val);
like = likelihood_bdk();
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
} else
yap_message("\n");
last_like = like;
last_val = val;
#endif
return val;
}
static double aterms_theta(double mya, void *mydata) {
int i, t;
double val = 0;
#ifdef A_DEBUG
float save_a = ddC.a_theta->a;
double like;
#endif
S_remake(ddC.a_theta, mya);
for (i=0; i<ddN.DT; i++) {
for (t=0; t<ddN.T; t++) {
if ( ddS.n_dt[i][t]>1 ) {
val += S_S(ddC.a_theta,ddS.n_dt[i][t],ddS.c_dt[i][t]);
}
}
val += poch(ddP.b_theta, mya, ddS.C_dT[i]);
}
myarms_evals++;
#ifdef A_DEBUG
yap_message("Eval aterms_theta(%lf) = %lf (S had %f)", mya, val, save_a);
ddP.a_theta = mya;
cache_update("at");
like = likelihood();
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
}
last_like = like;
last_val = val;
#endif
return val;
}
static double aterms_mu(double mya, void *mydata) {
int e, t;
double val = 0;
#ifdef A_DEBUG
float save_a = ddC.a_mu->a;
double like;
#endif
S_remake(ddC.a_mu, mya);
for (e=0; e<ddN.E; e++) {
for (t=0; t<ddN.T; t++) {
if ( ddS.cp_et[e][t]==0 )
continue;
if (e==ddN.E-1)
val += S_S(ddC.a_mu, ddS.C_eDt[e][t], ddS.cp_et[e][t]);
else
val +=
S_S(ddC.a_mu, ddS.C_eDt[e][t] + ddS.cp_et[e+1][t], ddS.cp_et[e][t]);
}
val += poch(ddP.b_mu[e], mya, ddS.Cp_e[e]);
}
myarms_evals++;
#ifdef A_DEBUG
yap_message("Eval aterms_mu(%lf) = %lf (S had %f)", mya, val, save_a);
ddP.a_mu = mya;
cache_update("am");
like = likelihood();
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
}
last_like = like;
last_val = val;
#endif
return val;
}
static int lookup_wild(const char *root, struct lookup_context *ctxt)
{
char mkey[KEY_MAX_LEN + 1];
char mapent[MAPENT_MAX_LEN + 1];
char *mapname;
FILE *f;
int entry;
time_t age = time(NULL);
mapname = alloca(strlen(ctxt->mapname) + 6);
sprintf(mapname, "file:%s", ctxt->mapname);
f = fopen(ctxt->mapname, "r");
if (!f) {
error(MODPREFIX "could not open map file %s", ctxt->mapname);
return 0;
}
while(1) {
entry = read_one(f, mkey, mapent);
if (entry)
if (strncmp(mkey, "*", 1) == 0) {
fclose(f);
return cache_update(root, "*", mapent, age);
}
if (feof(f))
break;
}
fclose(f);
return CHE_MISSING;
}
struct cache_object *cache_update_force(struct cache *c, void *ptr)
{
struct cache_object *obj;
int id;
obj = cache_find(c, ptr, &id);
if (obj) {
if (obj->status != C_OBJ_DEAD) {
cache_update(c, obj, id, ptr);
return obj;
} else {
cache_del(c, obj);
cache_object_free(obj);
}
}
obj = cache_object_new(c, ptr);
if (obj == NULL)
return NULL;
if (cache_add(c, obj, id) == -1) {
cache_object_free(obj);
return NULL;
}
return obj;
}
static double awterms(double myaw, void *mydata) {
int i, t;
double val = 0;
double law = log(myaw);
#ifdef A_DEBUG
float save_a = ddC.SY->a;
double like;
#endif
S_remake(ddC.SY, myaw);
for (t=0; t<ddN.T; t++) {
uint32_t Tw_ = 0;
for (i=0; i<ddN.W; i++) {
Tw_ += ddS.Twt[i][t];
if ( ddS.Nwt[i][t]>1 ) {
val += S_S(ddC.SY,ddS.Nwt[i][t],ddS.Twt[i][t]);
}
}
val += Tw_*law + lgamma(ddP_bwpar(t)/myaw+Tw_) - lgamma(ddP_bwpar(t)/myaw);
}
myarms_evals++;
#ifdef A_DEBUG
yap_message("Eval awterms(%lf) = %lf (S had %f)", myaw, val, save_a);
ddP.awpar = myaw;
cache_update("aw");
like = likelihood();
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
}
last_like = like;
last_val = val;
#endif
return val;
}
static double aterms_burst(double mya, void *mydata) {
double b[ddM.T];
double val = 0;
uint16_t **docstats = (uint16_t **)mydata;
#ifdef A_DEBUG
float save_a = ddC.a_burst->a;
double like;
#endif
int t;
for (t=0; t<ddM.T; t++)
b[t] = ddP.b_burst;
cache_update("ab");
val = dmi_likelihood_aterms(&ddM, docstats,
pctl_gammaprior, mya, b, ddC.a_burst);
myarms_evals++;
#ifdef A_DEBUG
yap_message("Eval adkterms(%lf) = %lf", mya, val);
like = dmi_likelihood(&ddM,pctl_gammaprior,mya,b,ddC.a_burst);
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
} else
yap_message("\n");
last_like = like;
last_val = val;
#endif
return val;
}
void sample_a0(double *mya0) {
#ifdef A_DEBUG
last_val = 0;
last_like = 0;
#endif
myarms(PYP_DISC_MIN, PYP_DISC_MAX, &a0terms, NULL, mya0, "a0");
cache_update("a0");
}
void sample_at(double *mya) {
#ifdef A_DEBUG
last_val = 0;
last_like = 0;
#endif
myarms(PYP_DISC_MIN, PYP_DISC_MAX, &aterms_theta, NULL, mya, "at");
ddP.a_theta = *mya;
cache_update("at");
}
static int cyclon_parse_data(struct peersampler_context *context, const uint8_t *buff, int len)
{
cache_check(context->local_cache);
if (len) {
const struct topo_header *h = (const struct topo_header *)buff;
struct peer_cache *remote_cache;
struct peer_cache *sent_cache = NULL;
if (h->protocol != MSG_TYPE_TOPOLOGY) {
fprintf(stderr, "Peer Sampler: Wrong protocol!\n");
return -1;
}
context->bootstrap = false;
remote_cache = entries_undump(buff + sizeof(struct topo_header), len - sizeof(struct topo_header));
if (h->type == CYCLON_QUERY) {
sent_cache = rand_cache(context->local_cache, context->sent_entries);
cyclon_reply(context->pc, remote_cache, sent_cache);
context->dst = NULL;
}
cache_check(context->local_cache);
cache_add_cache(context->local_cache, remote_cache);
cache_free(remote_cache);
if (sent_cache) {
cache_add_cache(context->local_cache, sent_cache);
cache_free(sent_cache);
} else {
if (context->flying_cache) {
cache_add_cache(context->local_cache, context->flying_cache);
cache_free(context->flying_cache);
context->flying_cache = NULL;
}
}
}
if (time_to_send(context)) {
if (context->flying_cache) {
cache_add_cache(context->local_cache, context->flying_cache);
cache_free(context->flying_cache);
context->flying_cache = NULL;
}
cache_update(context->local_cache);
context->dst = last_peer(context->local_cache);
if (context->dst == NULL) {
return 0;
}
context->dst = nodeid_dup(context->dst);
cache_del(context->local_cache, context->dst);
context->flying_cache = rand_cache(context->local_cache, context->sent_entries - 1);
return cyclon_query(context->pc, context->flying_cache, context->dst);
}
cache_check(context->local_cache);
return 0;
}
void sample_ap0(double *mya) {
#ifdef A_DEBUG
last_val = 0;
last_like = 0;
#endif
myarms(PYP_DISC_MIN, PYP_DISC_MAX, &aterms_phi0, NULL, mya, "ap0");
ddP.a_phi0 = *mya;
cache_update("ap0");
}
void cache_put( UCHAR *target, UCHAR *nodes_compact_list, int nodes_compact_size ) {
ITEM *item = NULL;
CACHE *cache = cache_find( target );
/* Found in cache, update cache, done */
if( cache != NULL ) {
cache_update( cache, target, nodes_compact_list, nodes_compact_size );
return;
}
cache = (CACHE *) myalloc( sizeof(CACHE) );
cache_update( cache, target, nodes_compact_list, nodes_compact_size );
time_add_30_min( &cache->lifetime );
time_add_5_min_approx( &cache->renew );
item = list_put( _main->cache->list, cache );
hash_put( _main->cache->hash, cache->target, SHA1_SIZE, item );
}
void sample_adk(double *mya) {
uint16_t **docstats;
#ifdef A_DEBUG
last_val = 0;
last_like = 0;
#endif
docstats = dmi_astore(&ddM);
myarms(PYP_DISC_MIN, PYP_DISC_MAX, &adkterms, docstats, mya, "adk");
cache_update("ad");
dmi_freeastore(&ddM, docstats);
}
void sample_ab(double *mya) {
uint16_t **docstats;
#ifdef A_DEBUG
last_val = 0;
last_like = 0;
#endif
docstats = dmi_astore(&ddM);
myarms(PYP_DISC_MIN, PYP_DISC_MAX, &aterms_burst, docstats, mya, "ab");
ddP.a_burst = *mya;
cache_update("ab");
dmi_freeastore(&ddM, docstats);
}
void sample_aw(double *myaw) {
#ifdef A_DEBUG
last_val = 0;
last_like = 0;
#endif
/*
* compute it in first pass,
* then use it inside awterms() and awterms_da()
*/
myarms(PYP_DISC_MIN, PYP_DISC_MAX, &awterms, NULL, myaw, "aw");
cache_update("aw");
}
int ncast_reply(struct ncast_proto_context *context, const struct peer_cache *c, const struct peer_cache *local_cache)
{
int ret;
struct peer_cache *send_cache;
send_cache = cache_copy(local_cache);
cache_update(send_cache);
ret = topo_reply(context->context, c, send_cache, MSG_TYPE_TOPOLOGY, NCAST_REPLY, 0, 1);
cache_free(send_cache);
return ret;
}
/*
* assumes uniform prior Dirichlet
*/
void sample_alpha(double *alphatot) {
double dirmax = DIR_TOTAL_MAX;
if ( dirmax>ddN.T * DIR_MAX )
dirmax = ddN.T * DIR_MAX;
#ifdef A_DEBUG
last_val = 0;
last_like = 0;
#endif
if ( myarmsMH(DIR_MIN*ddN.T, dirmax,
&alphaterms, NULL, alphatot, "alphatot",1) ) {
yap_message("sample_alpha: error in result\n");
}
cache_update("alpha");
}
void sample_a(double *mya) {
#ifdef A_DEBUG
last_val = 0;
last_like = 0;
#endif
if ( verbose>1 )
yap_message("sample_a (pre): a=%lf, lp=%lf\n",
*mya, likelihood());
myarms(PYP_DISC_MIN, PYP_DISC_MAX, &aterms, NULL, mya, "a");
cache_update("a");
if ( verbose>1 )
yap_message("sample_a (post): a=%lf, lp=%lf\n",
*mya, likelihood());
}
/* public:
* find a prop value from the file cache.
*
* the return value is the value of the given property key, or NULL if the
* property key is not found. the returned value is owned by the caller,
* and must be freed.
*/
char *hybris_propcache_find(const char *key)
{
char *ret = NULL;
cache_update();
/* then look up the key and do a copy if we get a result */
struct hybris_prop_value *prop = cache_find_internal(key);
if (prop)
return prop->value;
out:
return ret;
}
void hybris_propcache_list(hybris_propcache_list_cb cb, void *cookie)
{
int n;
struct hybris_prop_value *current;
if (!cb)
return;
cache_update();
for (n = 0; n < max_prop; n++) {
current = &prop_array[n];
cb(current->key, current->value, cookie);
}
}
bvm_cache *bvm_new(bvm_cache *this_bvm){ // bvm_new#
#ifdef BABEL_RESET_TRACE
_trace;
#endif
mword *self = tptr_detag(this_bvm, tptr_detag(this_bvm, this_bvm->self));
lci(bvm_dstack_ptr(this_bvm),0) = stack_new(this_bvm);
#define Y(a,b,c) \
if(!_exha(this_bvm, self, c)){ \
_insha( this_bvm, \
self, \
c, \
nil, \
hash_new_entry( \
this_bvm, \
c, \
nil, \
nil)); \
}
#define X(a,b,c) \
if(!trie_exists(this_bvm, self, c, nil)){ \
trie_insert(this_bvm, self, c, nil, nil); \
}
CACHED_FIELDS
#undef X
mword *local_root = _ith( this_bvm, trie_lookup_hash(this_bvm, self, BABEL_SYM_LOCAL_ROOT, nil), 2 );
if(is_nil(local_root)){
trie_insert(this_bvm, self, BABEL_SYM_LOCAL_ROOT, nil,
_ith( this_bvm, trie_lookup_hash(this_bvm, self, BABEL_SYM_SOFT_ROOT, nil), 2));
}
cache_update(this_bvm);
this_bvm->flags->BVM_CACHE_DIRTY = FLAG_CLR;
this_bvm->flags->BVM_CACHE_INVALID = FLAG_CLR;
return this_bvm;
}
static int open_entity(cache_handle_t *h, request_rec *r, const char *key)
{
cache_object_t *obj;
/* Look up entity keyed to 'url' */
if (sconf->lock) {
apr_thread_mutex_lock(sconf->lock);
}
obj = (cache_object_t *) cache_find(sconf->cache_cache, key);
if (obj) {
if (obj->complete) {
request_rec *rmain=r, *rtmp;
apr_atomic_inc32(&obj->refcount);
/* cache is worried about overall counts, not 'open' ones */
cache_update(sconf->cache_cache, obj);
/* If this is a subrequest, register the cleanup against
* the main request. This will prevent the cache object
* from being cleaned up from under the request after the
* subrequest is destroyed.
*/
rtmp = r;
while (rtmp) {
rmain = rtmp;
rtmp = rmain->main;
}
apr_pool_cleanup_register(rmain->pool, obj, decrement_refcount,
apr_pool_cleanup_null);
}
else {
obj = NULL;
}
}
if (sconf->lock) {
apr_thread_mutex_unlock(sconf->lock);
}
if (!obj) {
return DECLINED;
}
/* Initialize the cache_handle */
h->cache_obj = obj;
h->req_hdrs = NULL; /* Pick these up in recall_headers() */
return OK;
}
void cache_handler(int option, string url, string url_data, int size,int& a_cnt, int& m_cnt)
{
string check = cache_hit_miss(url);
if(check.compare("not found ... ") == 0)
{
cout<<"\n Access "<<access_count<<" missed in cache ...";
cache_update(url, url_data, size);
}
else
{
cache[url].page_entry = access_count;
}
access_count++;
a_cnt = access_count;
m_cnt = miss_count;
}
mword *_babel_root(bvm_cache *this_bvm, mword *loaded_bvm){ // _babel_root#
#ifdef BABEL_RESET_TRACE
_trace;
#endif
bvm_cache new_bvm;
bvm_cache *new_bvm_ptr = &new_bvm;
cache_new(this_bvm, new_bvm_ptr, loaded_bvm);
mword *bvm_initd = rci(cache_read_from_bvm(this_bvm, BABEL_SYM_BVM_INITD),0);
if(!rcl(bvm_initd,0)){
bvm_new(new_bvm_ptr);
lcl(bvm_initd,0) = 1;
}
else{
cache_update(new_bvm_ptr);
}
new_bvm_ptr->flags->BVM_CACHE_DIRTY = FLAG_CLR;
new_bvm_ptr->flags->BVM_CACHE_INVALID = FLAG_CLR;
babel_root_code_injection_point(new_bvm_ptr);
new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY = FLAG_CLR;
interp_core(new_bvm_ptr);
this_bvm->flags->BVM_CACHE_DIRTY = FLAG_CLR;
this_bvm->flags->BVM_CACHE_INVALID = FLAG_CLR;
// XXX Enhancement: handle return-from-root
// if(new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY == FLAG_SET){
// _msg("BVM_CODE_LIST_EMPTY");
// }
return nil;
}
static double aterms_phi1(double mya, void *mydata) {
int e, t, v;
double val = 0;
#ifdef A_DEBUG
float save_a = ddC.a_phi1->a;
double like;
#endif
S_remake(ddC.a_phi1, mya);
for (e=0; e<ddN.E; e++) {
for (t=0; t<ddN.T; t++) {
if ( ddS.S_Vte[t][e]==0 )
continue;
val += poch(ddP.b_phi[e][t], mya, ddS.S_Vte[t][e]);
for (v=0; v<ddN.W; v++) {
if ( ddS.s_vte[v][t][e]==0 )
continue;
if (e<ddN.E-1) {
val += S_S(ddC.a_phi1, ddS.m_vte[v][t][e] + ddS.s_vte[v][t][e+1] , ddS.s_vte[v][t][e]);
} else {
val += S_S(ddC.a_phi1, ddS.m_vte[v][t][e], ddS.s_vte[v][t][e]);
}
}
}
}
myarms_evals++;
#ifdef A_DEBUG
yap_message("Eval aterms_phi1(%lf) = %lf (S had %f)", mya, val, save_a);
ddP.a_phi1 = mya;
cache_update("ap"1);
like = likelihood();
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
}
last_like = like;
last_val = val;
#endif
return val;
}
static double alphaterms(double alphatot, void *mydata) {
int t,s;
double val = 0;
double tot;
double lga = lgamma(alphatot/ddN.T);
double lgat = lgamma(alphatot);
#ifdef A_DEBUG
double like;
#endif
#ifdef CONJPRIOR
val += ddN.T*(lgamma((alphatot+1.0)/ddN.T) - lga);
val -= lgamma(alphatot+1.0) - lgamma(alphatot);
#endif
for (s=0; s<ddN.DT; s++) {
tot = 0;
for (t=0; t<ddN.T; t++) {
tot += alphatot/ddN.T+ddS.Ndt[s][t];
val += gammadiff(ddS.Ndt[s][t],alphatot/ddN.T,lga);
}
val -= lgamma(tot) - lgat;
}
myarms_evals++;
myarms_last = alphatot;
#ifdef A_DEBUG
yap_message("Eval alphaterms(%lf) = %lf\n", alphatot, val);
ddP.alphatot = alphatot;
cache_update("alpha");
like = likelihood();
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
}
last_like = like;
last_val = val;
#endif
return val;
}
static double a0terms(double mya0, void *mydata) {
int i;
double l1a0 = log(1-mya0);
double l2a0 = log((1-mya0)*(2-mya0));
double lga0 = lgamma(1-mya0);
double val = 0;
#ifdef A_DEBUG
double like;
#endif
val += ddS.TDTnz*log(mya0) + lgamma(ddP.b0/mya0+ddS.TDTnz)
- lgamma(ddP.b0/mya0);
for (i=0; i<ddN.T; i++)
/* note the root node is a PDD so all t's = 1 */
if ( ddS.TDt[i]>1 ) {
if ( ddS.TDt[i]==2 )
val += l1a0;
else if ( ddS.TDt[i]==3 )
val += l2a0;
else
val += lgamma(ddS.TDt[i]-mya0) - lga0;
}
#ifdef A_DEBUG
yap_message("Eval a0terms(%lf) = %lf", mya0, val);
ddP.a0 = mya0;
cache_update("a0");
like = likelihood();
if ( last_val != 0 ) {
yap_message(", lp=%lf diffs=%lf vs %lf\n", like,
val-last_val, like-last_like);
}
last_like = like;
last_val = val;
#endif
myarms_evals++;
return val;
}
mword *_babel(bvm_cache *this_bvm, mword *loaded_bvm, mword *arg_stack, mword *sym_table){ // _babel#
bvm_cache new_bvm;
bvm_cache *new_bvm_ptr = &new_bvm;
mword *result = nil;
cache_new(this_bvm, new_bvm_ptr, loaded_bvm);
mword *self = tptr_detag(new_bvm_ptr, tptr_detag(new_bvm_ptr, new_bvm_ptr->self)); // Could blow up due to mem_alloc()
if( !trie_exists(new_bvm_ptr, self, BABEL_SYM_BVM_INITD, nil) ){
trie_insert( new_bvm_ptr, self, BABEL_SYM_BVM_INITD, nil, _val(new_bvm_ptr,1) );
// trie_insert( new_bvm_ptr, self, BABEL_SYM_BVM_INITD, nil, _val(new_bvm_ptr,0) );
}
mword *bvm_initd = rci(cache_read_from_bvm(new_bvm_ptr, BABEL_SYM_BVM_INITD),0);
if(!rcl(bvm_initd,0)){
bvm_new(new_bvm_ptr);
lcl(bvm_initd,0) = 1;
}
else{
cache_update(new_bvm_ptr);
}
if( !trie_exists(new_bvm_ptr, self, BABEL_SYM_CODE_RESTART_POINT, nil) ){
trie_insert( new_bvm_ptr, self, BABEL_SYM_CODE_RESTART_POINT, nil, rci(new_bvm_ptr->code_ptr,0));
}
new_bvm_ptr->flags->BVM_CACHE_DIRTY = FLAG_CLR;
new_bvm_ptr->flags->BVM_CACHE_INVALID = FLAG_CLR;
cache_flush(this_bvm);
if(!is_nil(sym_table)){
trie_insert(new_bvm_ptr, tptr_detag(new_bvm_ptr, new_bvm_ptr->self), BABEL_SYM_SOFT_ROOT, nil, sym_table);
}
trie_insert(new_bvm_ptr, tptr_detag(new_bvm_ptr, new_bvm_ptr->self), BABEL_SYM_PARENT_BVM, nil, this_bvm->self);
new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY = FLAG_CLR;
while(!is_nil(arg_stack)){ // give the arg-list onto the BVM's dstack
interp_push_operand(new_bvm_ptr, rci(arg_stack, 0));
arg_stack = rci(arg_stack,1);
}
interp_core(new_bvm_ptr);
cache_cp(new_bvm_ptr, this_bvm); //update flags and interp
this_bvm->self = _ith( this_bvm,
trie_lookup_hash(
new_bvm_ptr,
tptr_detag(new_bvm_ptr, new_bvm_ptr->self),
BABEL_SYM_PARENT_BVM,
nil),
2 );
cache_update(this_bvm);
this_bvm->flags->BVM_CACHE_DIRTY = FLAG_CLR;
this_bvm->flags->BVM_CACHE_INVALID = FLAG_CLR;
//copy TOS from new_bvm to this_bvm
oinfo oi;
oi.default_data = nil;
oi.required_tag = nil;
oi.mask = OI_MASK_ANY;
oi.min_size = 0;
oi.max_size = 1;
if( new_bvm_ptr->flags->BVM_RETURN_TOS_ON_EXIT == FLAG_SET
&&
(new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY == FLAG_SET
||
(get_advance_type(new_bvm_ptr) == BVM_RETURN))){
get_operands(new_bvm_ptr,1,&oi);
result = oi.data;
stack_pop(new_bvm_ptr,rci(new_bvm_ptr->dstack_ptr,0));
// stack_push(this_bvm,
// rci(this_bvm->dstack_ptr,0),
// stack_new_entry(
// this_bvm,
// oi.data,
// nil));
}
// Reset all flags in case of re-entry
new_bvm_ptr->flags->BVM_RETURN_TOS_ON_EXIT = FLAG_CLR; // FIXME: This restore to previous value, not force-clear
new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY = FLAG_CLR;
if(get_advance_type(new_bvm_ptr) == BVM_RETURN){
set_advance_type(new_bvm_ptr, BVM_ADVANCE);
}
this_bvm->flags->BVM_RETURN_TOS_ON_EXIT = FLAG_CLR;
this_bvm->flags->BVM_CODE_LIST_EMPTY = FLAG_CLR;
return result;
}