cell_t *invoke(cell_t *fun, cell_t *args, environ_t *env) {
int argslen, paramlen;
environ_t *new_env;
function_t *func = fun->slot2.fun;
cell_t *ret;
cell_t *code;
handle_t *hc;
argslen = proper_list_length(args,0);
paramlen = proper_list_length(func->param_list, 0);
if (argslen != paramlen) return NULL; /* error */
create_empty_environment(&new_env);
extend(func->lexical_env, new_env, func->param_list, args);
code = func->code;
hc = handle_push(code);
while (NULL != code && !NILP(code)) {
ret = evaluate(CAR(code), new_env); // code handled
code = handle_get(hc);
code = CDR(code);
handle_set(hc, code);
}
handle_pop(hc);
return ret;
}
static void handle_message(struct cfw_message *msg, void *param)
{
switch (CFW_MESSAGE_ID(msg)) {
case MSG_ID_CIRCULAR_STORAGE_PUSH_REQ:
handle_push(msg);
break;
case MSG_ID_CIRCULAR_STORAGE_POP_REQ:
handle_pop(msg);
break;
case MSG_ID_CIRCULAR_STORAGE_PEEK_REQ:
handle_peek(msg);
break;
case MSG_ID_CIRCULAR_STORAGE_CLEAR_REQ:
handle_clear(msg);
break;
case MSG_ID_LL_CIRCULAR_STORAGE_SHUTDOWN_REQ:
cfw_send_message(CFW_MESSAGE_PRIV(msg));
break;
case MSG_ID_CIRCULAR_STORAGE_GET_REQ:
handle_get(msg);
default:
cfw_print_default_handle_error_msg(LOG_MODULE_MAIN,
CFW_MESSAGE_ID(
msg));
break;
}
cfw_msg_free(msg);
}
cell_t *evargs(cell_t *args, environ_t *env) {
#define MAX_LISP_ARGS 16
handle_t *harray[MAX_LISP_ARGS];
int length;
int i;
cell_t *tmp, *head = nil_cell, *tail = nil_cell;
handle_t *hhandle, *thandle;
if ((length = proper_list_length(args, 0)) < 0) return NULL; /* error */
if (length > MAX_LISP_ARGS) return NULL; /* can only handle 16 args atm */
for (i = 0; i < length; i++, args = CDR(args)) {
harray[i] = handle_push(CAR(args));
}
for (i = 0; i < length; i++) {
cell_t *t = handle_get(harray[i]);
handle_set(harray[i], evaluate(t, env)); // everything handled
}
hhandle = handle_push(head);
thandle = handle_push(tail);
for (i = length - 1; i >= 0; i--) {
tmp = new(cell_t); // head and tail protected by handles
head = handle_get(hhandle);
tail = handle_get(thandle);
tail = head;
head = handle_get(harray[i]);
CONS(tmp, head, tail);
head = tmp;
handle_set(hhandle, head);
handle_set(thandle, tail);
}
handle_pop(thandle);
handle_pop(hhandle);
for (i = length - 1; i >= 0; i--) {
handle_pop(harray[i]);
}
return head;
}
void handle_msi_packet(Messenger *m, uint32_t friend_number, const uint8_t *data, uint16_t length, void *object)
{
LOGGER_DEBUG(m->log, "Got msi message");
MSISession *session = (MSISession *)object;
MSIMessage msg;
if (msg_parse_in(m->log, &msg, data, length) == -1) {
LOGGER_WARNING(m->log, "Error parsing message");
send_error(m, friend_number, msi_EInvalidMessage);
return;
}
LOGGER_DEBUG(m->log, "Successfully parsed message");
pthread_mutex_lock(session->mutex);
MSICall *call = get_call(session, friend_number);
if (call == NULL) {
if (msg.request.value != requ_init) {
send_error(m, friend_number, msi_EStrayMessage);
pthread_mutex_unlock(session->mutex);
return;
}
call = new_call(session, friend_number);
if (call == NULL) {
send_error(m, friend_number, msi_ESystem);
pthread_mutex_unlock(session->mutex);
return;
}
}
switch (msg.request.value) {
case requ_init:
handle_init(call, &msg);
break;
case requ_push:
handle_push(call, &msg);
break;
case requ_pop:
handle_pop(call, &msg); /* always kills the call */
break;
}
pthread_mutex_unlock(session->mutex);
}
static void handle_message(struct cfw_message * msg, void * param)
{
switch (CFW_MESSAGE_ID(msg)) {
case MSG_ID_LL_ERASE_BLOCK_REQ:
handle_erase_block(msg);
break;
case MSG_ID_LL_READ_PARTITION_REQ:
handle_read_partition(msg);
break;
case MSG_ID_LL_WRITE_PARTITION_REQ:
handle_write_partition(msg);
break;
#ifdef CONFIG_SERVICES_QUARK_SE_STORAGE_CIRCULAR
case MSG_ID_LL_CIR_STOR_INIT_REQ:
handle_cir_stor_init(msg);
break;
case MSG_ID_LL_PUSH_REQ:
handle_push(msg);
break;
case MSG_ID_LL_POP_REQ:
handle_pop(msg);
break;
case MSG_ID_LL_PEEK_REQ:
handle_peek(msg);
break;
case MSG_ID_LL_CLEAR_REQ:
handle_clear(msg);
break;
#endif
default:
cfw_print_default_handle_error_msg(LOG_MODULE_MAIN, CFW_MESSAGE_ID(msg));
break;
}
cfw_msg_free(msg);
}
cell_t *evaluate(cell_t *exp, environ_t *env) {
++__tl_eval_level;
// push a frame
eval_stack_t s;
s.next = eval_stack;
s.value = env;
eval_stack = &s;
if (DFLAG) {
printf("Eval (%d) got : ", __tl_eval_level);
pretty_print(exp);
}
if (NULL == exp) {
DRETURN(RET_VAL, NULL);
} else if (NILP(exp)) {
DRETURN(RET_VAL, nil_cell);
} else if (ATOMP(exp)) {
if (SYMBOLP(exp)) {
DRETURN(RET_VAL, find_value(env, exp));
} else if (STRINGP(exp) || NUMBERP(exp)) {
DRETURN(RET_VAL, exp);
} else {
DEBUGPRINT_("Expression not valid.\n");
pretty_print(orig_sexpr);
GOTO_TOPLEVEL();
return NULL; /* unreachable */
}
} else { /* list */
handle_t *he = handle_push(exp);
cell_t *first = evaluate(CAR(exp), env); // exp handled
exp = handle_get(he);
handle_pop(he);
cell_t *rest = CDR(exp);
if (DFLAG) {
printf("First is: ");
pretty_print(first);
printf("Rest is: ");
pretty_print(rest);
}
if (NULL == first) {
fast_error(" malformed expression.");
/* This is unreachable */
} else if (PRIMITIVEP(first)) {
cell_t *(*f)(cell_t *, environ_t *) = CELL_PRIMITIVE(first);
DRETURN(RET_PRIM, (*f)(rest, env));
} else if (FUNCTIONP(first)) { /* function call */
cell_t *t;
handle_t *hf;
hf = handle_push(first);
t = evargs(rest, env); // first handled
first = handle_get(hf);
handle_pop(hf);
DRETURN(RET_FUNCALL, invoke(first, t, env)); // no need for handles
}
undefun_error(first, exp); /* Not primitive or funcall, error.*/
return NULL; /* Unreachable, undefun_error() does not return. */
}
}
