// mtree walk function for creating ttree nodes
// used by _t_new_from_m
void _m_2tfn(H h,N *n,void *data,MwalkState *s,Maddr ap) {
T **tP = (T**) &(((struct {T *t;} *)data)->t);
T *t = h.a.l ? (s[h.a.l-1].user.t) : NULL;
int is_run_node = (n->flags&TFLAG_RUN_NODE);
T *nt;
if (n->flags & TFLAG_SURFACE_IS_TREE && !(n->flags & TFLAG_SURFACE_IS_RECEPTOR)) {
if (is_run_node) raise_error("not implemented");
nt = _t_newt(t,n->symbol,_t_new_from_m(*(H *)n->surface));
}
else if (n->flags & TFLAG_ALLOCATED) {
nt = __t_new(t,n->symbol,n->surface,n->size,is_run_node);
}
else {
nt = __t_new(t,n->symbol,&n->surface,n->size,is_run_node);
}
nt->context.flags |= (~TFLAG_ALLOCATED)&(n->flags);
if (is_run_node) {
((rT *)nt)->cur_child = n->cur_child;
}
*tP = nt;
s[h.a.l].user.t = nt;
}
/**
* Build a run tree from a code tree and params
*
* @param[in] processes processes trees
* @param[in] process Process tree node to be turned into run tree
* @param[in] num_params the number of parameters to add to the parameters child
* @param[in] ... T params
* @returns T RUN_TREE tree
*/
T *_p_make_run_tree(T *processes,T *process,int num_params,...) {
T *t = NULL;
va_list params;
Process p = *(Process *)_t_surface(process);
if (!is_process(p)) {
raise_error("%s is not a Process",_d_get_process_name(processes,p));
}
if (is_sys_process(p)) {
t = _t_new_root(RUN_TREE);
// if it's a sys process we add the parameters directly as children to the process
// because no sys-processes refer to PARAMS by path
// this also means we need rclone them instead of clone them because they
// will actually need to have space for the status marks by the processing code
T *c = __t_new(t,p,0,0,sizeof(rT));
va_start(params,num_params);
int i;
for(i=0;i<num_params;i++) {
_t_add(c,_t_rclone(va_arg(params,T *)));
}
va_end(params);
}
else {
T *code_def = _d_get_process_code(processes,p);
T *code = _t_child(code_def,3);
va_list params;
va_start(params,num_params);
t = __p_build_run_tree_va(code,num_params,params);
va_end(params);
}
return t;
}
/**
* 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;
}
