Пример #1
0
/**
 * 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??
    }
}
Пример #2
0
/**
 * 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);
}
Пример #3
0
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;
}
Пример #4
0
/**
 * 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);
}
Пример #5
0
// 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;
    }
}
Пример #6
0
/**
 * 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;
}
Пример #7
0
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);

}
Пример #8
0
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);
}
Пример #9
0
/**
 * 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);
}
Пример #10
0
void sys_free() {
    _t_free(_t_root(G_sem->stores[0].definitions));
    _sem_free(G_sem);
}
Пример #11
0
/**
 * 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;
}
Пример #12
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;
}
Пример #13
0
/**
 * 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);
}