/** * 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?? } }
/** * Destroys a vmhost freeing all memory it uses. * * @param[in] v the VMHost to free */ void _v_free(VMHost *v) { _r_free(v->r); _s_free(v->installed_receptors); _t_free(_t_root(v->sem->stores[0].definitions)); _sem_free(v->sem); free(v); }
T *sT_(SemTable *sem,Symbol sym,int num_params,...){ va_list params; T *set = _t_newr(0,sym); va_start(params,num_params); int i; for(i=0;i<num_params;i++) { T * t = va_arg(params,T *); if (semeq(_t_symbol(t),STRUCTURE_SYMBOL)) { Symbol ss = *(Symbol *)_t_surface(t); if (is_structure(ss)) { T *structures = _sem_get_defs(G_sem,ss); T *st = _t_child(structures,ss.id); if (!st) { raise_error("Structure used in %s definition is undefined!",G_label); } else { _t_free(t); t = _t_clone(_t_child(st,2)); } } else if (ss.id == -1) {raise_error("Symbol used in %s definition is undefined!",G_label);} } _t_add(set,t); } va_end(params); return set; }
/** * free the resources in a queue, including any run-trees * * @param[in] q the queue to be freed */ void _p_freeq(Q *q) { Qe *e = q->active; _p_free_elements(q->active); _p_free_elements(q->completed); _p_free_elements(q->blocked); if (q->pending_signals) _t_free(q->pending_signals); free(q); }
// clean up a context including its run-trees _p_free_context(R *c) { while(c) { // free any run_trees that are roots, i.e. assume // that a tree in a context that's part of another tree // will get freed elsewhere. if (!_t_parent(c->run_tree)) _t_free(c->run_tree); R *n = c->caller; free(c); c = n; } }
/** * 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; }
void makeShell(VMHost *v,FILE *input, FILE *output,Receptor **irp,Receptor **orp,Stream **isp,Stream **osp) { // define and then create the shell receptor Symbol shell = _d_define_receptor(v->r->sem,"shell",__r_make_definitions(),DEV_COMPOSITORY_CONTEXT); Receptor *r = _r_new(v->sem,shell); Xaddr shellx = _v_new_receptor(v,v->r,shell,r); _v_activate(v,shellx); // create stdin/out receptors Stream *output_stream = *osp = _st_new_unix_stream(output,0); Stream *input_stream = *isp = _st_new_unix_stream(input,1); Receptor *i_r = *irp = _r_makeStreamEdgeReceptor(v->sem); _r_addReader(i_r,input_stream,r->addr,DEFAULT_ASPECT,parse_line,LINE,false); Xaddr ix = _v_new_receptor(v,v->r,STREAM_EDGE,i_r); _v_activate(v,ix); Receptor *o_r = *orp = _r_makeStreamEdgeReceptor(v->sem); _r_addWriter(o_r,output_stream,DEFAULT_ASPECT); Xaddr ox = _v_new_receptor(v,v->r,STREAM_EDGE,o_r); _v_activate(v,ox); // set up shell to express the line parsing protocol when it receives LINES from the stream reader Protocol clp; __sem_get_by_label(v->sem,"PARSE_COMMAND_FROM_LINE",&clp,DEV_COMPOSITORY_CONTEXT); T *bindings = _t_new_root(PROTOCOL_BINDINGS); T *res = _t_newr(bindings,RESOLUTION); T *w = _t_newr(res,WHICH_RECEPTOR); _t_news(w,ROLE,LINE_SENDER); __r_make_addr(w,ACTUAL_RECEPTOR,i_r->addr); res = _t_newr(bindings,RESOLUTION); w = _t_newr(res,WHICH_RECEPTOR); _t_news(w,ROLE,COMMAND_RECEIVER); __r_make_addr(w,ACTUAL_RECEPTOR,r->addr); res = _t_newr(bindings,RESOLUTION); w = _t_newr(res,WHICH_SYMBOL); _t_news(w,USAGE,COMMAND_TYPE); _t_news(w,ACTUAL_SYMBOL,SHELL_COMMAND); _o_express_role(r,clp,COMMAND_RECEIVER,DEFAULT_ASPECT,bindings); _t_free(bindings); // set up shell to use the CLOCK TELL_TIME protocol for the time command Protocol time; __sem_get_by_label(v->sem,"time",&time,CLOCK_CONTEXT); T *code = _t_new_root(INITIATE_PROTOCOL); _t_news(code,PNAME,time); _t_news(code,WHICH_INTERACTION,tell_time); bindings = _t_newr(code,PROTOCOL_BINDINGS); res = _t_newr(bindings,RESOLUTION); w = _t_newr(res,WHICH_RECEPTOR); _t_news(w,ROLE,TIME_HEARER); __r_make_addr(w,ACTUAL_RECEPTOR,r->addr); res = _t_newr(bindings,RESOLUTION); w = _t_newr(res,WHICH_RECEPTOR); _t_news(w,ROLE,TIME_TELLER); ReceptorAddress clock_addr = {3}; // @todo bogus!!! fix getting clock address somehow __r_make_addr(w,ACTUAL_RECEPTOR,clock_addr); res = _t_newr(bindings,RESOLUTION); w = _t_newr(res,WHICH_PROCESS); _t_news(w,GOAL,RESPONSE_HANDLER); addCommand(r,o_r->addr,"time","get time",code,w); // (expect (on flux SHELL_COMMAND:receptor) action (send std_out (convert_to_lines (send vmhost receptor-list)))) code = _t_newi(0,MAGIC,MagicReceptors); addCommand(r,o_r->addr,"receptors","get receptor list",code,NULL); // (expect (on flux SHELL_COMMAND:receptor) action (send std_out (convert_to_lines (send vmhost shutdown))) code = _t_newi(0,MAGIC,MagicQuit); addCommand(r,o_r->addr,"quit","shut down the vmhost",code,NULL); // (expect (on flux SHELL_COMMAND:debug) action (send std_out (convert_to_lines (magic toggle debug))) code = _t_newi(0,MAGIC,MagicDebug); addCommand(r,o_r->addr,"debug","toggle debug mode",code,NULL); }
void _visdump(Defs *defs,T *x,int *path) { T *delta = makeDelta(TREE_DELTA_REPLACE,path,x,1); wjson(defs,delta,G_visdump_fn,G_visdump_count++); _t_free(delta); }
/** * scaffolding for send a signal from ouside the VMhost * * <b>Examples (from test suite):</b> * @snippet spec/vmhost_spec.h testVMHostActivateReceptor */ void _v_send(VMHost *v,ReceptorAddress from,ReceptorAddress to,Aspect aspect,Symbol carrier,T *contents) { T *s = __r_make_signal(from,to,aspect,carrier,contents,0,0); T *x = _r_send(v->r,s); _t_free(x); }
void sys_free() { _t_free(_t_root(G_sem->stores[0].definitions)); _sem_free(G_sem); }
/** * 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); }