/**
* walk through the list of signals and send them
*/
void _v_send_signals(VMHost *v,T *signals) {
while(_t_children(signals)>0) {
T *s = _t_detach_by_idx(signals,1);
T *r = _r_send(v->r,s);
_t_free(r); //@todo WHAT???? throwing away the rsult??
}
}
/**
* scaffolding function for signal delivery
*/
void _v_deliver_signals(VMHost *v, Receptor *sender) {
T *signals = sender->pending_signals;
while(_t_children(signals)>0) {
T *s = _t_detach_by_idx(signals,1);
T *envelope = _t_child(s,1);
// T *contents = _t_child(s,2);
ReceptorAddress *toP = (ReceptorAddress *)_t_surface(_t_child(_t_child(envelope,EnvelopeToIdx),1));
ReceptorAddress *fromP = (ReceptorAddress *)_t_surface(_t_child(_t_child(envelope,EnvelopeFromIdx),1));
// if the from or to address is "self" (-1) we find the senders self
// fix the values in the signal we are about to deliver.
if (fromP->addr == SELF_RECEPTOR_ADDR) {
*fromP = __r_get_self_address(sender);
}
Receptor *r;
if (toP->addr == SELF_RECEPTOR_ADDR) {
*toP = __r_get_self_address(sender);
}
else {
if (toP->addr >= v->receptor_count) {
raise_error("to address: %d doesn't exist!",toP->addr);
}
r = v->routing_table[toP->addr].r;
}
Error err = _r_deliver(r,s);
if (err) {
raise_error("delivery error: %d",err);
}
}
}
// helper function to recursively travers a ttree and build an mtree out of it
// used by _m_new_from_t
H __mnft(H parent,T *t) {
int i, c = _t_children(t);
H h = _m_new(parent,_t_symbol(t),_t_surface(t),_t_size(t));
for(i=1;i<=c;i++) {
__mnft(h,_t_child(t,i));
}
return h;
}
/**
* add a structure definition to a structure defs tree
*
* @param[in] structures a structre def tree containing structure definitions
* @param[in] label a c-string label for this symbol
* @param[in] num_params number of symbols in the structure
* @param[in] ... variable list of Symbol type symbols
* @returns the new structure def
*
* <b>Examples (from test suite):</b>
* @snippet spec/def_spec.h testDefStructure
*/
Structure _d_define_structure(T *structures,char *label,Context c,int num_params,...) {
va_list params;
va_start(params,num_params);
T *def = _dv_define_structure(structures,label,num_params,params);
va_end(params);
Symbol sym = {c,SEM_TYPE_STRUCTURE,_t_children(structures)};
return sym;
}
// @todo, convert this to hash table label table!!
bool __sem_get_by_label(SemTable *sem,char *label,SemanticID *sid,Context c) {
ContextStore *ctx = __sem_context(sem,c);
T *d = ctx->definitions;
if (!d) raise_error("no definitions in context %s",_sem_ctx2s(sem,c));
int i,j;
for(i=1;i<=_t_children(d);i++) {
T *defs = _t_child(d,i);
for(j=1;j<=_t_children(defs);j++) {
T *def = _t_child(defs,j);
if (strcmp(label,(char *)_t_surface(_t_child(_t_child(def,DefLabelIdx),1)))==0) {
sid->semtype = i;
sid->id = j;
sid->context = c;
return true;
}
}
}
return false;
}
/**
* check a group of parameters to see if they match a process input signature
*
* @param[in] defs definition trees needed for the checking
* @param[in] p the Process we are checking against
* @param[in] params list of parameters
*
* @returns Error code
*
* @todo add SIGNATURE_SYMBOL for setting up process signatures by Symbol not just Structure
*/
Error __p_check_signature(Defs *defs,Process p,T *params) {
T *def = _d_get_process_code(defs->processes,p);
T *input = _t_child(def,4);
int i = _t_children(input);
int c = _t_children(params);
if (i > c) return tooFewParamsReductionErr;
if (i < c) return tooManyParamsReductionErr;
for(i=1;i<=c;i++) {
T *sig = _t_child(_t_child(input,i),1);
if(semeq(_t_symbol(sig),SIGNATURE_STRUCTURE)) {
Structure ss = *(Symbol *)_t_surface(sig);
if (!semeq(_d_get_symbol_structure(defs->symbols,_t_symbol(_t_child(params,i))),ss) && !semeq(ss,TREE))
return signatureMismatchReductionErr;
}
else {
raise_error("unknown signature checking symbol: %s",_d_get_symbol_name(0,_t_symbol(sig)));
}
}
return 0;
}
/*
special runtree builder that uses the actual params tree node. This is used
in the process of reduction because we don't have to clone the param values, we
can use the actual tree nodes that are being reduced as they are already rT nodes
and they are only used once, i.e. in this reduction
*/
T *__p_make_run_tree(T *processes,Process p,T *params) {
T *code_def = _d_get_process_code(processes,p);
T *code = _t_child(code_def,3);
T *t = _t_new_root(RUN_TREE);
T *c = _t_rclone(code);
_t_add(t,c);
T *ps = _t_newr(t,PARAMS);
int i,num_params = _t_children(params);
for(i=1;i<=num_params;i++) {
_t_add(ps,_t_detach_by_idx(params,1));
}
return t;}
/**
* get symbol's label
*
* @param[in] symbols a symbol def tree containing symbol definitions
* @param[in] s the Symbol to return the name for
* @returns char * pointing to label
*
* <b>Examples (from test suite):</b>
* @snippet spec/def_spec.h testSymbolGetName
*/
char *_d_get_symbol_name(T *symbols,Symbol s) {
if (is_sys_symbol(s)) {
if (s.id == 0) return "NULL_SYMBOL";
symbols = G_sys_defs.symbols;
}
if (is_sys_test_symbol(s))
symbols = G_sys_defs.symbols;
if (symbols) {
int c = _t_children(symbols);
if (s.id > c || s.id < 1) {
raise_error2("Bad symbol:%d--%d symbols in decl list",s.id,c);
}
T *def = _t_child(symbols,s.id);
T *l = _t_child(def,1);
return (char *)_t_surface(_t_child(def,1));
}
sprintf(__d_extra_buf,"<unknown symbol:%d.%d.%d>",s.context,s.flags,s.id);
return __d_extra_buf;
}
/**
* install a receptor into vmhost, creating a symbol for it
*
* @param[in] v VMHost in which to install the receptor
* @param[in] package xaddr of package to install
* @param[in] bindings completed manifest which specifies how the receptor will be installed
* @param[in] label label to be used for the semantic name for this receptor
* @returns Xaddr of the instance
*
* <b>Examples (from test suite):</b>
* @snippet spec/vmhost_spec.h testVMHostInstallReceptor
*/
Xaddr _v_install_r(VMHost *v,Xaddr package,T *bindings,char *label) {
raise_error("not implemented");
T *p;// = _r_get_instance(v->c,package);
T *id = _t_child(p,2);
TreeHash h = _t_hash(v->r->sem,id);
// make sure we aren't re-installing an already installed receptor
Xaddr x = _s_get(v->installed_receptors,h);
if (!(is_null_xaddr(x))) return G_null_xaddr;
_s_add(v->installed_receptors,h,package);
// confirm that the bindings match the manifest
/// @todo expand the manifest to allow optional binding, etc, using semtrex to do the matching instead of assuming positional matching
if (bindings) {
T *m = _t_child(p,1);
int c = _t_children(m);
if (c%2) {raise_error("manifest must have even number of children!");}
int i;
for(i=1;i<=c;i++) {
T *mp = _t_child(m,i);
T *s = _t_child(mp,2);
T *bp = _t_child(bindings,i);
if (!bp) {
raise_error("missing binding for %s",(char *)_t_surface(_t_child(mp,1)));
}
T *vb = _t_child(bp,2);
Symbol spec = *(Symbol *)_t_surface(s);
if (semeq(_t_symbol(vb),spec)) {
T *symbols = _t_child(p,3);
raise_error("bindings symbol %s doesn't match spec %s",_sem_get_name(v->r->sem,_t_symbol(vb)),_sem_get_name(v->r->sem,spec));
}
}
}
Symbol s = _r_define_symbol(v->r,RECEPTOR,label);
raise_error("fix semtable");
Receptor *r = _r_new_receptor_from_package(NULL,s,p,bindings);
return _v_new_receptor(v,v->r,s,r);
}
// helper function to recursively traverse a ttree and build an mtree out of it
// used by _m_new_from_t
H __mnft(H parent,T *t) {
int i, c = _t_children(t);
// clear the allocated flag, because that will get recalculated in __m_new
uint32_t flags = t->context.flags & ~TFLAG_ALLOCATED;
// if the ttree points to a type that has an allocated c structure as its surface
// it must be copied into the mtree as reference, otherwise it would get freed twice
// when the mtree is freed
if (flags & (TFLAG_SURFACE_IS_RECEPTOR+TFLAG_SURFACE_IS_SCAPE+TFLAG_SURFACE_IS_STREAM)) flags |= TFLAG_REFERENCE;
void *surface = _t_surface(t);
void *sp;
H h;
if (flags & TFLAG_SURFACE_IS_TREE && !(flags & TFLAG_SURFACE_IS_RECEPTOR)) {
H sh = _m_new_from_t((T *)surface);
h = _m_newt(parent,_t_symbol(t),sh);
}
else {
if (flags & (TFLAG_SURFACE_IS_RECEPTOR+TFLAG_SURFACE_IS_SCAPE+TFLAG_SURFACE_IS_STREAM)) {
sp = surface;
surface = &sp;
}
h = __m_new(parent,_t_symbol(t),surface,_t_size(t),flags);
}
if (flags&TFLAG_RUN_NODE) {
// @todo, make this more efficient, ie we shouldn't have to
// do an _m_get, instead there should be a way for mtrees to create run_nodes
N *n = __m_get(h);
n->cur_child = ((rT *)t)->cur_child;
}
for(i=1;i<=c;i++) {
__mnft(h,_t_child(t,i));
}
return h;
}
// this is used to set the structure definition of a declared but undefined strcture
void __d_set_structure_def(T *structures,Structure s,T *def) {
T *d = _t_child(structures,s.id);
if (_t_children(d) > 1) raise_error("Structure already defined");
_t_add(d,def);
}
/**
* get the structure for a given symbol
*
* @param[in] symbols a symbol def tree containing symbol definitions
* @param[in] s the symbol
* @returns a Structure
*
* <b>Examples (from test suite):</b>
* @snippet spec/def_spec.h testGetSymbolStructure
*/
Structure __d_get_symbol_structure(T *symbols,Symbol s) {
T *def = _t_child(symbols,s.id);
if (!def) {
raise_error("Bad symbol:%d.%d.%d-- only %d symbols in decl list",s.context,s.semtype,s.id,_t_children(symbols));
}
T *t = _t_child(def,SymbolDefStructureIdx);
return *(Structure *)_t_surface(t);
}
/**
* reduce system level processes in a run tree. Assumes that the children have already been
* reduced and all parameters have been filled in
*
* these system level processes are the equivalent of the instruction set of the ceptr virtual machine
*/
Error __p_reduce_sys_proc(R *context,Symbol s,T *code) {
int b,c;
char *str;
Symbol sy;
T *x,*t,*match_results,*match_tree;
Error err = noReductionErr;
switch(s.id) {
case NOOP_ID:
// noop simply replaces itself with it's own child
x = _t_detach_by_idx(code,1);
break;
case IF_ID:
t = _t_child(code,1);
b = (*(int *)_t_surface(t)) ? 2 : 3;
x = _t_detach_by_idx(code,b);
break;
case ADD_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
*((int *)&x->contents.surface) = c+*((int *)&x->contents.surface);
break;
case SUB_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
*((int *)&x->contents.surface) = *((int *)&x->contents.surface)-c;
break;
case MULT_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
*((int *)&x->contents.surface) = *((int *)&x->contents.surface)*c;
break;
case DIV_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
if (!c) {
_t_free(x);
return divideByZeroReductionErr;
}
*((int *)&x->contents.surface) = *((int *)&x->contents.surface)/c;
break;
case MOD_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
if (!c) {
_t_free(x);
return divideByZeroReductionErr;
}
*((int *)&x->contents.surface) = *((int *)&x->contents.surface)%c;
break;
case EQ_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
*((int *)&x->contents.surface) = *((int *)&x->contents.surface)==c;
x->contents.symbol = BOOLEAN;
break;
case LT_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
*((int *)&x->contents.surface) = *((int *)&x->contents.surface)<c;
x->contents.symbol = BOOLEAN;
break;
case GT_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
*((int *)&x->contents.surface) = *((int *)&x->contents.surface)>c;
x->contents.symbol = BOOLEAN;
break;
case LTE_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
*((int *)&x->contents.surface) = *((int *)&x->contents.surface)<=c;
x->contents.symbol = BOOLEAN;
break;
case GTE_INT_ID:
x = _t_detach_by_idx(code,1);
c = *(int *)_t_surface(_t_child(code,1));
*((int *)&x->contents.surface) = *((int *)&x->contents.surface)>=c;
x->contents.symbol = BOOLEAN;
break;
case CONCAT_STR_ID:
// if the first parameter is a RESULT SYMBOL then we use that as the symbol type for the result tree.
x = _t_detach_by_idx(code,1);
sy = _t_symbol(x);
if (semeq(RESULT_SYMBOL,sy)) {
sy = *(Symbol *)_t_surface(x);
_t_free(x);
x = _t_detach_by_idx(code,1);
}
//@todo, add a bunch of sanity checking here to make sure the
// parameters are all CSTRINGS
c = _t_children(code);
// make sure the surface was allocated and if not, converted to an alloced surface
if (c > 0) {
if (!(x->context.flags & TFLAG_ALLOCATED)) {
int v = *((int *)&x->contents.surface); // copy the string as an integer
str = (char *)&v; // calculate the length
int size = strlen(str)+1;
x->contents.surface = malloc(size);
memcpy(x->contents.surface,str,size);
t->context.flags = TFLAG_ALLOCATED;
}
}
// @todo this would probably be faster with just one total realloc for all children
for(b=1;b<=c;b++) {
str = (char *)_t_surface(_t_child(code,b));
int size = strlen(str);
x->contents.surface = realloc(x->contents.surface,x->contents.size+size);
memcpy(x->contents.surface+x->contents.size-1,str,size);
x->contents.size+=size;
*( (char *)x->contents.surface + x->contents.size -1) = 0;
}
x->contents.symbol = sy;
break;
case RESPOND_ID:
{
T *signal = _t_parent(context->run_tree);
if (!signal || !semeq(_t_symbol(signal),SIGNAL))
return notInSignalContextReductionError;
T *response_contents = _t_detach_by_idx(code,1);
T *envelope = _t_child(signal,1);
Xaddr to = *(Xaddr *)_t_surface(_t_child(envelope,1)); // reverse the from and to
Xaddr from = *(Xaddr *)_t_surface(_t_child(envelope,2));
Aspect a = *(Aspect *)_t_surface(_t_child(envelope,3));
// add the response signal into the outgoing signals list of the root
// run-tree (which is always the last child)
R *root = context;
while (context->caller) root = context->caller;
int kids = _t_children(root->run_tree);
T *signals;
if (kids == 1 || (!semeq(SIGNALS,_t_symbol(signals = _t_child(root->run_tree,kids)))))
signals = _t_newr(root->run_tree,SIGNALS); // make signals list if it's not there
T *response = __r_make_signal(from,to,a,response_contents);
_t_add(signals,response);
x = _t_newi(0,TEST_INT_SYMBOL,0);
}
// @todo figure what RESPOND should return, since really it's a side-effect instruction
// perhaps some kind of signal context symbol or something. Right now using TEST_INT_SYMBOL
// as a bogus placeholder.
break;
case QUOTE_ID:
x = _t_detach_by_idx(code,1);
break;
case EXPECT_ACT_ID:
// detach the carrier and expectation and construction params, and enqueue the expectation and action
// on the carrier
{
T *carrier_param = _t_detach_by_idx(code,1);
T *carrier = *(T **)_t_surface(carrier_param);
_t_free(carrier_param);
T *ex = _t_detach_by_idx(code,1);
T *expectation = _t_new_root(EXPECTATION);
_t_add(expectation,ex);
T *params = _t_detach_by_idx(code,1);
//@todo: this is a fake way to add an expectation to a carrier (as a c pointer
// out of the params)
// we probably actually need a system representation for carriers and an API
// that will also make this thread safe. For example, in the case of carrier being
// a receptor's aspect/flux then we should be using _r_add_listener here, but
// unfortunately we don't want to have to know about receptors this far down in the
// stack... But it's not clear yet how we do know about the listening context as
// I don't think it should be copied into every execution context (the R struct)
_t_add(carrier,expectation);
_t_add(carrier,params);
// the action is a pointer back to this context for now were using a EXPECT_ACT
// with the c pointer as the surface because I don't know what else to do... @fixme
// perhaps this should be a BLOCKED_EXPECT_ACTION process or something...
_t_new(carrier,EXPECT_ACT,&context,sizeof(context));
}
rt_cur_child(code) = 1; // reset the current child count on the code
x = _t_detach_by_idx(code,1);
// the actually blocking happens in redcueq which can remove the process from the
// round-robin
err = Block;
break;
case SEND_ID:
{
T *t = _t_detach_by_idx(code,1);
Xaddr to = *(Xaddr *)_t_surface(t);
_t_free(t);
T* signal_contents = _t_detach_by_idx(code,1);
Xaddr from = {RECEPTOR_XADDR,0}; //@todo how do we say SELF??
x = __r_make_signal(from,to,DEFAULT_ASPECT,signal_contents);
}
err = Send;
break;
case INTERPOLATE_FROM_MATCH_ID:
match_results = _t_child(code,2);
match_tree = _t_child(code,3);
x = _t_detach_by_idx(code,1);
// @todo interpolation errors?
_p_interpolate_from_match(x,match_results,match_tree);
break;
case RAISE_ID:
return raiseReductionErr;
break;
case READ_STREAM_ID:
{
T *s = _t_detach_by_idx(code,1);
FILE *stream =*(FILE**)_t_surface(s);
_t_free(s);
s = _t_detach_by_idx(code,1);
sy = _t_symbol(s);
if (semeq(RESULT_SYMBOL,sy)) {
sy = *(Symbol *)_t_surface(s);
_t_free(s);
int ch;
char buf[1000]; //@todo handle buffer dynamically
int i = 0;
while ((ch = fgetc (stream)) != EOF && ch != '\n' && i < 1000)
buf[i++] = ch;
if (i>=1000) {raise_error0("buffer overrun in READ_STREAM");}
buf[i++]=0;
x = _t_new(0,sy,buf,i);
}
else {raise_error0("expecting RESULT_SYMBOL");}
}
break;
default:
raise_error("unknown sys-process id: %d",s.id);
}
// any remaining children of 'code' are the parameters which have all now been "used up"
// so we can call the low-level __t_free the clean them up and then replace the contents of
// the 'code' node with the contents of the 'x' node that was either detached or produced
// by the the process that just ran
__t_free(code);
code->structure.child_count = x->structure.child_count;
code->structure.children = x->structure.children;
code->contents = x->contents;
code->context = x->context;
free(x);
return err;
}
/**
* take one step in the execution state machine given a run-tree context
*
* a run_tree is expected to have a code tree as the first child, parameters as the second,
* and optionally an error handling routine as the third child.
*
* @param[in] processes context of defined processes
* @param[in] pointer to context pointer
* @returns the next state that will be called for the context
*/
Error _p_step(Defs *defs, R **contextP) {
R *context = *contextP;
switch(context->state) {
case noReductionErr:
case Block:
case Send:
raise_error0("whoa, virtual states can't be executed!"); // shouldn't be calling step if Done or noErr or Block or Send
break;
case Pop:
// if this was the successful reduction by an error handler
// move the value to the 1st child
if (context->err) {
T *t = _t_detach_by_idx(context->run_tree,3);
if (t) {
_t_replace(context->run_tree,1,t);
context->err = noReductionErr;
}
}
// if this is top caller on the stack then we are completely done
if (!context->caller) {
context->state = Done;
break;
}
else {
// otherwise pop the context
R *ctx = context;
context = context->caller; // set the new context
if (!ctx->err) {
// get results of the run_tree
T *np = _t_detach_by_idx(ctx->run_tree,1);
_t_replace(context->parent,context->idx,np); // replace the process call node with the result
rt_cur_child(np) = RUN_TREE_EVALUATED;
context->node_pointer = np;
context->state = Eval; // or possible ascend??
}
else context->state = ctx->err;
// cleanup
_t_free(ctx->run_tree);
free(ctx);
context->callee = 0;
*contextP = context;
}
break;
case Eval:
{
T *np = context->node_pointer;
if (!np) {
raise_error0("Whoa! Null node pointer");
}
Process s = _t_symbol(np);
if (semeq(s,PARAM_REF)) {
T *param = _t_get(context->run_tree,(int *)_t_surface(np));
if (!param) {
raise_error0("request for non-existent param");
}
context->node_pointer = np = _t_rclone(param);
_t_replace(context->parent, context->idx,np);
s = _t_symbol(np);
}
// @todo what if the replaced parameter is itself a PARAM_REF tree ??
// if this node is not a process, i.e. it's data, then we are done descending
// and it will be the result so ascend
if (!is_process(s)) {
context->state = Ascend;
}
else {
int c = _t_children(np);
if (c == rt_cur_child(np) || semeq(s,QUOTE)) {
// if the current child == the child count this means
// all the children have been processed, so we can evaluate this process
// if the process is QUOTE that's a special case and we evaluate it
// immediately without descending.
if (!is_sys_process(s)) {
// if it's user defined process then we check the signature and then make
// a new run-tree run that process
Error e = __p_check_signature(defs,s,np);
if (e) context->state = e;
else {
T *run_tree = __p_make_run_tree(defs->processes,s,np);
context->state = Pushed;
*contextP = __p_make_context(run_tree,context);
}
}
else {
// if it's a sys process we can just reduce it in and then ascend
// or move to the error handling state
Error e = __p_reduce_sys_proc(context,s,np);
context->state = e ? e : Ascend;
}
}
else if(c) {
//descend and increment the current child we're working on!
context->state = Descend;
}
else {
raise_error0("whoa! brain fart!");
}
}
}
break;
case Ascend:
rt_cur_child(context->node_pointer) = RUN_TREE_EVALUATED;
context->node_pointer = context->parent;
context->parent = _t_parent(context->node_pointer);
if (!context->parent || context->parent == context->run_tree) {
context->idx = 1;
}
else context->idx = rt_cur_child(context->parent);
if (context->node_pointer == context->run_tree)
context->state = Pop;
else
context->state = Eval;
break;
case Descend:
context->parent = context->node_pointer;
context->idx = ++rt_cur_child(context->node_pointer);
context->node_pointer = _t_child(context->node_pointer,context->idx);
context->state = Eval;
break;
default:
context->err = context->state;
if (_t_children(context->run_tree) <= 2) {
// no error handler so just return the error
context->state = Pop;
}
else {
// the first parameter to the error code is always a reduction error
// which gets added on as the 4th child of the run tree when the
// error happens.
T *ps = _t_newr(context->run_tree,PARAMS);
//@todo: fix this so we don't actually use an error value that
// then has to be translated into a symbol, but rather so that we
// can programatically calculate the symbol.
Symbol se;
switch(context->state) {
case tooFewParamsReductionErr: se=TOO_FEW_PARAMS_ERR;break;
case tooManyParamsReductionErr: se=TOO_MANY_PARAMS_ERR;break;
case signatureMismatchReductionErr: se=SIGNATURE_MISMATCH_ERR;break;
case notProcessReductionError: se=NOT_A_PROCESS_ERR;break;
case notInSignalContextReductionError: se=NOT_IN_SIGNAL_CONTEXT_ERR;
case divideByZeroReductionErr: se=ZERO_DIVIDE_ERR;break;
case incompatibleTypeReductionErr: se=INCOMPATIBLE_TYPE_ERR;break;
case raiseReductionErr:
se = *(Symbol *)_t_surface(_t_child(context->node_pointer,1));
break;
default: raise_error("unknown reduction error: %d",context->state);
}
T *err = __t_new(ps,se,0,0,sizeof(rT));
int *path = _t_get_path(context->node_pointer);
_t_new(err,ERROR_LOCATION,path,sizeof(int)*(_t_path_depth(path)+1));
free(path);
// switch the node_pointer to the top of the error handling routine
context->node_pointer = _t_child(context->run_tree,3);
context->idx = 3;
context->parent = context->run_tree;
context->state = Eval;
}
}
return context->state;
}
/**
* bootstrap the ceptr system
*
* starts up the vmhost and wakes up receptors that should be running in it.
*
* @TODO check the compository to verify our version of the vmhost
*
*/
void _a_boot(char *dir_path) {
// check if the storage directory exists
struct stat st = {0};
if (stat(dir_path, &st) == -1) {
// if no directory we are firing up an initial instance, so
// create directory
mkdir(dir_path,0700);
// instantiate a VMHost object
G_vm = _v_new();
// create the basic receptors that all VMHosts have
_v_instantiate_builtins(G_vm);
}
else {
char fn[1000];
void *buffer;
// unserialize the semtable base tree
SemTable *sem = _sem_new();
T *t = __a_unserializet(dir_path,SEM_FN);
sem->stores[0].definitions = t;
// restore definitions to the correct store slots
T *paths = __a_unserializet(dir_path,PATHS_FN);
int i = 0;
int c = _t_children(paths);
for(i=1;i<=c;i++) {
T *p = _t_child(paths,i);
if (semeq(RECEPTOR_PATH,_t_symbol(p))) {
T *x = _t_get(t,(int *)_t_surface(p));
sem->stores[i-1].definitions = x;
}
}
_t_free(paths);
sem->contexts = c+1;
// unserialize all of the vmhost's instantiated receptors and other instances
__a_vmfn(fn,dir_path);
buffer = readFile(fn,0);
Receptor *r = _r_unserialize(sem,buffer);
G_vm = __v_init(r,sem);
free(buffer);
// unserialize other vmhost state data
S *s;
__a_vm_state_fn(fn,dir_path);
s = readFile(fn,0);
H h = _m_unserialize(s);
free(s);
H hars; hars.m=h.m; hars.a = _m_child(h,1); // first child is ACTIVE_RECEPTORS
H har; har.m=h.m;
int j = _m_children(hars);
for (i=1;i<=j;i++) {
har.a = _m_child(hars,i);
if(!semeq(_m_symbol(har),RECEPTOR_XADDR)) raise_error("expecting RECEPTOR_XADDR!");
_v_activate(G_vm,*(Xaddr *)_m_surface(har));
}
_m_free(h);
}
G_vm->dir = dir_path;
// _a_check_vm_host_version_on_the_compository();
_v_start_vmhost(G_vm);
}
/**
* add a symbol definition to a symbol defs tree
*
* @param[in] symbols a symbol def tree containing symbol definitions
* @param[in] s the structure type for this symbol
* @param[in] label a c-string label for this symbol
* @param[in] the context in which this symbol is being declared
* @returns the new symbol
* @todo this is not thread safe!
*
* <b>Examples (from test suite):</b>
* @snippet spec/def_spec.h testDefSymbol
*/
Symbol _d_declare_symbol(T *symbols,Structure s,char *label,Context c){
__d_declare_symbol(symbols,s,label);
Symbol sym = {c,SEM_TYPE_SYMBOL,_t_children(symbols)};
return sym;
}
