void visdump(Defs *defs,T *x) {
if (G_visdump_count) {
int *path = _t_get_path(x);
_visdump(defs,x,path);
free(path);
}
}
/**
* clean shutdown of the the ceptr system
*
* should be called by the thread that called _a_boot() (or _a_start_vmhost())
*/
void _a_shut_down() {
// cleanly close down any processing in the VM_Host
__r_kill(G_vm->r);
_v_join_thread(&G_vm->clock_thread);
_v_join_thread(&G_vm->vm_thread);
char fn[1000];
// serialize the semtable
__a_serializet(_t_root(G_vm->sem->stores[0].definitions),SEM_FN);
int i;
T *paths = _t_new_root(RECEPTOR_PATHS);
for (i=0;i<G_vm->sem->contexts;i++) { // we don't need the path of the root so start at 1
int *p = _t_get_path(G_vm->sem->stores[i].definitions);
if (p) {
_t_new(paths,RECEPTOR_PATH,p,sizeof(int)*(_t_path_depth(p)+1));
free(p);
}
else
_t_newr(paths,STRUCTURE_ANYTHING); // should be something like DELETED_CONTEXT
}
__a_serializet(paths,PATHS_FN);
_t_free(paths);
// serialize the receptor part of the vmhost
void *surface;
size_t length;
_r_serialize(G_vm->r,&surface,&length);
// _r_unserialize(surface);
__a_vmfn(fn,G_vm->dir);
writeFile(fn,surface,length);
free(surface);
// serialize other parts of the vmhost
H h = _m_newr(null_H,SYS_STATE);
H har = _m_newr(h,ACTIVE_RECEPTORS);
for (i=0;i<G_vm->active_receptor_count;i++) {
_m_new(har,RECEPTOR_XADDR,&G_vm->active_receptors[i].x,sizeof(Xaddr));
}
S *s = _m_serialize(h.m);
__a_vm_state_fn(fn,G_vm->dir);
writeFile(fn,s,s->total_size);
free(s);
_m_free(h);
// free the memory used by the SYS_RECEPTOR
_v_free(G_vm);
G_vm = NULL;
}
/**
* reduce all the processes in a queue
*
* @param[in] q the queue to be processed
*/
Error _p_reduceq(Q *q) {
#ifdef debug_reduce
printf("\n\nStarting reduce:\n");
#endif
Qe *qe = q->active;
Error next_state;
struct timespec start, end;
while (q->contexts_count) {
#ifdef debug_reduce
R *context = qe->context;
char *sn[]={"Ascend","Descend","Pushed","Pop","Eval","Block","Send","Done"};
char *s = context->state <= 0 ? sn[-context->state -1] : "Error";
printf("ID:%p -- State %s : %d\n",qe,s,context->state);
printf(" idx:%d\n",context->idx);
puts(_t2s(q->defs,context->run_tree));
if (context) {
if (context->node_pointer == 0) {
printf("Node Pointer: NULL!\n");
}
else {
printf("rt_cur_child:%d\n",rt_cur_child(context->node_pointer));
int *path = _t_get_path(context->node_pointer);
char pp[255];
_t_sprint_path(path,pp);
printf("Node Pointer:%s\n",pp);
free(path);
}
}
printf("\n");
#endif
clock_gettime(CLOCK_MONOTONIC, &start);
next_state = _p_step(q->defs, &qe->context); // next state is set in directly in the context
clock_gettime(CLOCK_MONOTONIC, &end);
qe->accounts.elapsed_time += diff_micro(&start, &end);
Qe *next = qe->next;
if (next_state == Done) {
// remove from the round-robin
__p_dequeue(q->active,qe);
// add to the completed list
__p_enqueue(q->completed,qe);
q->contexts_count--;
}
else if (next_state == Block) {
// remove from the round-robin
__p_dequeue(q->active,qe);
// add to the blocked list
__p_enqueue(q->blocked,qe);
q->contexts_count--;
}
else if (next_state == Send) {
// remove from the round-robin
__p_dequeue(q->active,qe);
// take the signal off the run tree and send it, adding a send result in it's place
T *signal = qe->context->node_pointer;
T *parent = _t_parent(signal);
//@todo figure out what that return value should be. Probably some result from
// the actual signal sending machinery, or at least what ever is going to
// evaluate the destination address for validity.
T *result = _t_newi(0,TEST_INT_SYMBOL,0);
//@todo refactor this into a version of _t_replace that swaps out the given child and returns it
// rather than freeing it.
parent->structure.children[0] = result; // 0 is the first child
result->structure.parent = parent;
signal->structure.parent = NULL;
_t_add(q->pending_signals,signal);
// add to the blocked list
__p_enqueue(q->blocked,qe);
q->contexts_count--;
}
qe = next ? next : q->active; // next in round robing or wrap
};
// @todo figure out what error we should be sending back here, i.e. what if
// one process ended ok, but one did not. What's the error? Probably
// the errors here would be at a different level, and the caller would be
// expected to inspect the errors of the reduced processes.
return 0;
}
/**
* 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;
}
