/*
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;}
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);
}
/**
* 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;
}
/**
* 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;
}
/**
* @brief Creates a new receptor
*
* allocates all the memory needed in the heap
*
* @param[in] r semantic ID 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(SemTable *sem,SemanticID r) {
T *t = _t_new_root(RECEPTOR_INSTANCE);
_t_news(t,INSTANCE_OF,r);
if (semeq(r,SYS_RECEPTOR)) {
_t_newi(t,CONTEXT_NUM,0);
_t_newi(t,PARENT_CONTEXT_NUM,-1);
}
else {
_t_newi(t,CONTEXT_NUM,_d_get_receptor_context(sem,r));
_t_newi(t,PARENT_CONTEXT_NUM,r.context);
}
T *state = _r_make_state();
_t_add(t,state);
return __r_init(t,sem);
}
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);
}
// 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);
}
SemanticID _d_define(SemTable *sem,T *def,SemanticType semtype,Context c) {
T *definitions = __sem_get_defs(sem,semtype,c);
_t_add(definitions,def);
SemanticID sid = {c,semtype,_d_get_def_addr(def)};
return sid;
}
/**
* 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;
}
/**
* 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;
}
