/// va_list version of _d_define_structure
T * _dv_define_structure(T *structures,char *label,int num_params,va_list params) {
T *def = _t_newr(structures,STRUCTURE_DEFINITION);
T *l = _t_new(def,STRUCTURE_LABEL,label,strlen(label)+1);
T *p = _t_newr(def,STRUCTURE_PARTS);
int i;
for(i=0;i<num_params;i++) {
_t_news(p,STRUCTURE_PART,va_arg(params,Symbol));
}
return def;
}
T *_r_make_state() {
T *t = _t_new_root(RECEPTOR_STATE);
T *f = _t_newr(t,FLUX);
__r_add_aspect(f,DEFAULT_ASPECT);
_t_newr(t,PENDING_SIGNALS);
_t_newr(t,PENDING_RESPONSES);
_t_newr(t,CONVERSATIONS);
_t_newi(t,RECEPTOR_ELAPSED_TIME,0);
return t;
}
/**
* @brief Creates a new receptor
*
* allocates all the memory needed in the heap
*
* @param[in] s symbol for this receptor
* @returns pointer to a newly allocated Receptor
*
* <b>Examples (from test suite):</b>
* @snippet spec/receptor_spec.h testReceptorCreate
*/
Receptor *_r_new(Symbol s) {
T *defs = _t_new_root(DEFINITIONS);
_t_newr(defs,STRUCTURES);
_t_newr(defs,SYMBOLS);
_t_newr(defs,PROCESSES);
_t_newr(defs,PROTOCOLS);
_t_newr(defs,SCAPES);
T *aspects = _t_new_root(ASPECTS);
return __r_new(s,defs,aspects);
}
/**
* define a new structure
*
* @param[in] sem is the semantic table to which to add the structure
* @param[in] label a c-string label for this structures
* @param[in] structure_def the STRUCTURE_DEF definitions
* @returns the new structure def
*
* <b>Examples (from test suite):</b>
* @snippet spec/def_spec.h testDefStructure
*/
Structure _d_define_structure(SemTable *sem,char *label,T *structure_def,Context c) {
T *def = _t_new_root(STRUCTURE_DEFINITION);
T *l = _t_newr(def,STRUCTURE_LABEL);
_t_new_str(l,ENGLISH_LABEL,label);
if (structure_def) _t_add(def,structure_def);
return _d_define(sem,def,SEM_TYPE_STRUCTURE,c);
}
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;
}
// create a TREE_DELTA tree
T *makeDelta(Symbol sym,int *path,T *t,int count) {
T *d = _t_new_root(sym);
_t_new(d,TREE_DELTA_PATH,path,sizeof(int)*(_t_path_depth(path)+1));
_t_add(_t_newr(d,TREE_DELTA_VALUE),_t_clone(t));
if (count)
_t_newi(d,TREE_DELTA_COUNT,count);
return d;
}
/**
* add a symbol definition to a symbol defs tree
*
* @param[in] sem is the semantic table to which to add the symbol
* @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_define_symbol(SemTable *sem,Structure s,char *label,Context c){
__d_validate_structure(sem,s,label);
T *def = _t_new_root(SYMBOL_DEFINITION);
T *l = _t_newr(def,SYMBOL_LABEL);
_t_new_str(l,ENGLISH_LABEL,label);
_t_news(def,SYMBOL_STRUCTURE,s);
return _d_define(sem,def,SEM_TYPE_SYMBOL,c);
}
/**
* low level functon to build a run tree from a code tree and a variable list of params
*/
T *__p_build_run_tree_va(T* code,int num_params,va_list params) {
T *t = _t_new_root(RUN_TREE);
T *c = _t_rclone(code);
_t_add(t,c);
T *ps = _t_newr(t,PARAMS);
int i;
for(i=1;i<=num_params;i++) {
_t_add(ps,_t_clone(va_arg(params,T *)));
}
return t;
}
// build a STRUCTURE_SEQUENCE STRUCTURE_DEF out of va_list
T * _d_make_vstruc_def(SemTable *sem,char *label,int num_params,va_list params) {
T *p,*seq = 0;
if (num_params > 1)
seq = _t_newr(0,STRUCTURE_SEQUENCE);
int i;
for(i=0;i<num_params;i++) {
Symbol s = va_arg(params,Symbol);
__d_validate_symbol(sem,s,label);
p = _t_news(seq,STRUCTURE_SYMBOL,s);
}
return seq ? seq : p;
}
/*
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;}
/**
* 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 addCommand(Receptor *r,ReceptorAddress ox,char *command,char *desc,T *code,T *bindings_handler) {
T *expect = _t_new_root(PATTERN);
T *s = _t_news(expect,SEMTREX_GROUP,SHELL_COMMAND);
T *cm = _sl(s,SHELL_COMMAND);
T *vl = _t_newr(cm,SEMTREX_VALUE_LITERAL);
T *vls = _t_newr(vl,SEMTREX_VALUE_SET);
_t_new_str(vls,VERB,command);
T *p = _t_new_root(SAY);
__r_make_addr(p,TO_ADDRESS,ox);
_t_news(p,ASPECT_IDENT,DEFAULT_ASPECT);
_t_news(p,CARRIER,NULL_SYMBOL);
// if code is actually an INITIATE then we will have a bindings handler
// to which we want to add the SAY command as the ACTUAL_PROCESS
// and we will replace the p with code which does the proper protocol
// initiation. Kinda weird, I know...
if (bindings_handler) {
char proc_name[255] = "handle ";
strcpy(&proc_name[7],command);
int pt1[] = {2,1,TREE_PATH_TERMINATOR};
_t_new(p,PARAM_REF,pt1,sizeof(int)*3);
Process proc = _r_define_process(r,p,proc_name,"long desc...",NULL,NULL);
_t_news(bindings_handler,ACTUAL_PROCESS,proc);
p = code;
}
else {
_t_add(p,code);
}
Process proc = _r_define_process(r,p,desc,"long desc...",NULL,NULL);
T *act = _t_newp(0,ACTION,proc);
_r_add_expectation(r,DEFAULT_ASPECT,SHELL_COMMAND,expect,act,0,0,NULL,NULL);
}
//helper to make empty definitions tree
T *__r_make_definitions() {
T *defs = _t_new_root(DEFINITIONS);
_t_newr(defs,STRUCTURES);
_t_newr(defs,SYMBOLS);
_t_newr(defs,PROCESSES);
_t_newr(defs,RECEPTORS);
_t_newr(defs,PROTOCOLS);
_t_newr(defs,SCAPES);
return defs;
}
Receptor *__r_new(Symbol s,T *defs,T *aspects) {
T *t = _t_new_root(s);
_t_add(t,defs);
_t_add(t,aspects);
T *f = _t_newr(t,FLUX);
T *a = _t_newi(f,ASPECT,DEFAULT_ASPECT);
_t_newr(a,LISTENERS);
_t_newr(a,SIGNALS);
_t_newr(t,RECEPTOR_STATE);
_t_newr(t,PENDING_SIGNALS);
_t_newr(t,PENDING_RESPONSES);
return __r_init(t);
}
//@todo fix this because it relies on SemanticTypes value matching the index order in the definitions.
// DO_KIDS(defs,__r_set_labels(r,_t_child(defs,i),i));
return r;
}
T *__r_build_default_until() {
T *until = _t_new_root(END_CONDITIONS);
_t_newr(until,UNLIMITED);
return until;
}
// helper to build and expectation tree
T *__r_build_expectation(Symbol carrier,T *pattern,T *action,T *with,T *until,T *using,T *cid) {
T *e = _t_newr(0,EXPECTATION);
_t_news(e,CARRIER,carrier);
_t_add(e,pattern);
_t_add(e,action);
if (!with) with = _t_new_root(PARAMS);
_t_add(e,with);
if (!until) {
until = __r_build_default_until();
}
_t_add(e,until);
if (using)
_t_add(e,using);
if (cid) {
_t_add(e,cid);
}
return e;
/**
* 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;
}
/**
* 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;
}
T *__r_build_default_until() {
T *until = _t_new_root(END_CONDITIONS);
_t_newr(until,UNLIMITED);
return until;
}
T *__r_add_aspect(T *flux,Aspect aspect) {
T *a = _t_newr(flux,aspect);
_t_newr(a,EXPECTATIONS);
_t_newr(a,SIGNALS);
return a;
}
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);
}
/**
* 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
* @returns the new symbol def
*
* <b>Examples (from test suite):</b>
* @snippet spec/def_spec.h testDefSymbol
*/
T *__d_declare_symbol(T *symbols,Structure s,char *label){
T *def = _t_newr(symbols,SYMBOL_DECLARATION);
_t_new(def,SYMBOL_LABEL,label,strlen(label)+1);
_t_news(def,SYMBOL_STRUCTURE,s);
return def;
}
