/* Remove top object from the sexp stack. */
static object_t *pop (reader_t * r)
{
if (!r->done && stack_height (r) <= 1)
{
read_error (r, "unbalanced parenthesis");
return err_symbol;
}
if (!r->done && r->state->dotpair_mode == 1)
{
read_error (r, "missing cdr object for dotted pair");
return err_symbol;
}
object_t *p = CDR (r->state->head);
CDR (r->state->head) = NIL;
obj_destroy (r->state->head);
if (r->state->vector_mode)
{
r->state--;
object_t *v = list2vector (p);
obj_destroy (p);
return v;
}
r->state--;
return p;
}
/*
* Load the actions attributes
*/
int
gilP_load_att_actions(FILE * inFile, ABObj obj, ABObj module)
{
int return_value = 0;
int rc = 0; /* r turn code */
ABObj action = NULL;
if (!abio_get_list_begin(inFile))
return (abil_print_load_err(ERR_WANT_LIST), -1);
while (!abio_get_list_end(inFile))
{
action = obj_create(AB_TYPE_ACTION, NULL);
if ((rc = get_action(inFile, obj, module, action)) < 0)
{
obj_destroy(action);
return rc;
}
else
{
if (obj_get_when(action) == AB_WHEN_UNDEF)
{
/* unsupported :when value - ignore it and continue */
obj_destroy(action);
}
else
{
install_action(obj, module, action);
}
}
}
return return_value;
}
object_t *lisp_while (object_t * lst)
{
DOC ("Continually evaluate body until first argument evals nil.");
REQM (lst, 1, c_sym ("while"));
object_t *r = NIL, *cond = CAR (lst), *body = CDR (lst);
object_t *condr;
while ((condr = eval (cond)) != NIL)
{
obj_destroy (r);
obj_destroy (condr);
CHECK (condr);
r = eval_body (body);
}
return r;
}
object_t *lisp_cond (object_t * lst)
{
DOC ("Eval car of each argument until one is true. Then eval cdr of\n"
"that argument.");
object_t *p = lst;
while (p != NIL)
{
if (!CONSP (p))
THROW (improper_list, UPREF (lst));
object_t *pair = CAR (p);
if (!CONSP (pair))
THROW (wrong_type, UPREF (pair));
if (!LISTP (CDR (pair)))
THROW (improper_list, UPREF (pair));
if (CDR (pair) == NIL)
return UPREF (CAR (pair));
if (CDR (CDR (pair)) != NIL)
THROW (c_sym ("bad-form"), UPREF (pair));
object_t *r = eval (CAR (pair));
if (r != NIL)
{
obj_destroy (r);
return eval (CAR (CDR (pair)));
}
p = CDR (p);
}
return NIL;
}
void vset (object_t * vo, size_t i, object_t * val)
{
vector_t *v = OVAL (vo);
object_t *o = v->v[i];
v->v[i] = val;
obj_destroy (o);
}
void vector_destroy (vector_t * v)
{
size_t i;
for (i = 0; i < v->len; i++)
obj_destroy (v->v[i]);
xfree (v->v);
mm_free (mm, (void *) v);
}
// Destroy the object space.
void object_space_destroy(object_space_t* space)
{
obj_t* object = hash_get(space->lobby->slots, "Object");
free(object);
obj_destroy(space->lobby);
free(space);
space = NULL;
}
/* Remove top object from the sexp stack. */
static void reset (reader_t * r)
{
r->done = 1;
while (r->state != r->base)
obj_destroy (pop (r));
reset_buf (r);
r->readbufp = r->readbuf;
r->done = 0;
}
smmgr_status_t grpobj_goto_ready(xid_t xid, obj_t obj)
{
int rc = MLU_STATUS_SUCCESS;
struct grp_desc *grp_desc;
smmgr_status_t status = SMMGR_STATUS_COMPLETE;
u32 ready_cnt = 0;
u32 err_cnt = 0;
grp_desc = GRP_DESC(obj);
if (grp_desc->persistent_data.destroy_when_empty &&
(RTL_HASHTABLE_NR_ENTRIES(&grp_desc->members) == 0)) {
rc = obj_destroy(xid, obj);
if (rc != MLU_STATUS_SUCCESS) {
MLU_TRACE(TL_ERR, "xid:0x%x failed to destroy "
"grp obj "OID_FMT", rc:0x%x\n",
xid, OBJ_ID(OBJ_OID(obj)), rc);
status = SMMGR_STATUS_INCOMPLETE;
}
goto ready_exit;
}
rc = grpobj_monitor_members(xid, obj, &ready_cnt, &err_cnt);
if (rc != MLU_STATUS_SUCCESS) {
MLU_TRACE(TL_ERR, "xid:0x%x failed to monitor members, "
"grp obj "OID_FMT", rc:0x%x\n",
xid, OBJ_ID(OBJ_OID(obj)), rc);
status = SMMGR_STATUS_INCOMPLETE;
goto ready_exit;
}
if (err_cnt != 0) {
MLU_TRACE(TL_WRN, "xid:0x%x grp obj "OID_FMT" err_cnt:%d\n",
xid, OBJ_ID(OBJ_OID(obj)), err_cnt);
obj_fail(xid, obj, -1);
status = SMMGR_STATUS_INCOMPLETE;
goto ready_exit;
}
if (ready_cnt != RTL_HASHTABLE_NR_ENTRIES(&grp_desc->members)) {
/* Loop back to ASYNC_CALLS_COMPLETE and run to READY
* again. We don't reach READY until all members are
* in READY state.
*/
obj_set_private_state(xid, obj,
GRP_STATE_ASYNC_CALLS_COMPLETE);
status = SMMGR_STATUS_INCOMPLETE;
goto ready_exit;
}
ready_exit:
MLU_TRACE(TL_INF, "xid:0x%x grp obj "OID_FMT" ready, sts:0x%x\n",
xid, OBJ_ID(OBJ_OID(obj)), status);
return status;
}
/* This destroys the current project and creates
* a new default project named "project" since
* dtbuilder can never have a NULL project.
*/
int
proj_destroy_project(
ABObj proj
)
{
obj_set_flag(proj, BeingDestroyedFlag);
obj_destroy(proj);
proj_create_new_proj(NULL);
return OK;
}
object_t *let (object_t * lst)
{
DOC ("Create variable bindings in a new scope, and eval "
"body in that scope.");
/* verify structure */
if (!LISTP (CAR (lst)))
THROW (c_sym ("bad-let-form"), UPREF (lst));
object_t *vlist = CAR (lst);
while (vlist != NIL)
{
object_t *p = CAR (vlist);
if (!LISTP (p))
THROW (c_sym ("bad-let-form"), UPREF (lst));
if (!SYMBOLP (CAR (p)))
THROW (c_sym ("bad-let-form"), UPREF (lst));
vlist = CDR (vlist);
}
object_t *p;
p = vlist = CAR (lst);
int cnt = 0;
while (p != NIL)
{
object_t *pair = CAR (p);
object_t *e = eval (CAR (CDR (pair)));
if (e == err_symbol)
{
/* Undo scoping */
p = vlist;
while (cnt)
{
sympop (CAR (CAR (p)));
p = CDR (p);
cnt--;
}
return err_symbol;
}
sympush (CAR (pair), e);
obj_destroy (e);
p = CDR (p);
cnt++;
}
object_t *r = eval_body (CDR (lst));
p = vlist;
while (p != NIL)
{
object_t *pair = CAR (p);
sympop (CAR (pair));
p = CDR (p);
}
return r;
}
object_t *lisp_if (object_t * lst)
{
DOC ("If conditional special form.");
REQM (lst, 2, wrong_number_of_arguments);
object_t *r = eval (CAR (lst));
CHECK (r);
if (r != NIL)
{
obj_destroy (r);
return eval (CAR (CDR (lst)));
}
return eval_body (CDR (CDR (lst)));
}
object_t *cdoc_string (object_t * lst)
{
DOC ("Return doc-string for CFUNC or SPECIAL.");
REQ (lst, 1, c_sym ("cdoc-string"));
object_t *fo = CAR (lst);
int evaled = 0;
if (SYMBOLP (fo))
{
evaled = 1;
fo = eval (fo);
}
if (fo->type != CFUNC && fo->type != SPECIAL)
{
if (evaled)
obj_destroy (fo);
THROW (wrong_type, UPREF (fo));
}
cfunc_t f = FVAL (fo);
object_t *str = f (doc_string);
if (evaled)
obj_destroy (fo);
return str;
}
smmgr_status_t grpobj_goto_members_ready(xid_t xid, obj_t obj)
{
int rc = MLU_STATUS_SUCCESS;
struct grp_desc *grp_desc;
smmgr_status_t status = SMMGR_STATUS_COMPLETE;
u32 ready_cnt = 0;
u32 err_cnt = 0;
grp_desc = GRP_DESC(obj);
if (grp_desc->persistent_data.destroy_when_empty &&
(RTL_HASHTABLE_NR_ENTRIES(&grp_desc->members) == 0)) {
rc = obj_destroy(xid, obj);
if (rc != MLU_STATUS_SUCCESS) {
MLU_TRACE(TL_ERR, "xid:0x%x failed to destroy "
"grp obj "OID_FMT", rc:0x%x\n",
xid, OBJ_ID(OBJ_OID(obj)), rc);
status = SMMGR_STATUS_INCOMPLETE;
}
goto members_ready_exit;
}
rc = grpobj_monitor_members(xid, obj, &ready_cnt, &err_cnt);
if (rc != MLU_STATUS_SUCCESS) {
MLU_TRACE(TL_ERR, "xid:0x%x failed to monitor members, "
"grp obj "OID_FMT", rc:0x%x\n",
xid, OBJ_ID(OBJ_OID(obj)), rc);
status = SMMGR_STATUS_INCOMPLETE;
goto members_ready_exit;
}
if (err_cnt != 0) {
MLU_TRACE(TL_WRN, "xid:0x%x grp obj "OID_FMT" err_cnt:%d\n",
xid, OBJ_ID(OBJ_OID(obj)), err_cnt);
obj_fail(xid, obj, -1);
status = SMMGR_STATUS_INCOMPLETE;
goto members_ready_exit;
}
if (ready_cnt != RTL_HASHTABLE_NR_ENTRIES(&grp_desc->members)) {
status = SMMGR_STATUS_INCOMPLETE;
goto members_ready_exit;
}
members_ready_exit:
MLU_TRACE(TL_INF, "xid:0x%x grp obj "OID_FMT" members ready, sts:0x%x\n",
xid, OBJ_ID(OBJ_OID(obj)), status);
return status;
}
/* Use the core functions above to eval each sexp in a file. */
int load_file (FILE * fid, char *filename, int interactive)
{
if (fid == NULL)
{
fid = fopen (filename, "r");
if (fid == NULL)
return 0;
}
reader_t *r = reader_create (fid, NULL, filename, interactive);
while (!r->eof)
{
object_t *sexp = read_sexp (r);
if (sexp != err_symbol)
{
object_t *ret = top_eval (sexp);
if (r->interactive && ret != err_symbol)
obj_print (ret, 1);
obj_destroy (sexp);
obj_destroy (ret);
}
}
reader_destroy (r);
return 1;
}
object_t *lisp_and (object_t * lst)
{
DOC ("Evaluate each argument until one returns nil.");
object_t *r = T, *p = lst;
while (CONSP (p))
{
obj_destroy (r);
r = eval (CAR (p));
CHECK (r);
if (r == NIL)
return NIL;
p = CDR (p);
}
if (p != NIL)
THROW (improper_list, UPREF (lst));
return UPREF (r);
}
int cgmgr_destroy_cg(xid_t xid, struct mlu_ioctl_destroy_cg_args *argp)
{
int rc = 0;
obj_t cg_obj = NULL;
obj_t member = NULL;
struct obj_iter iter;
cg_obj = objmgr_access_obj(xid, argp->cg_oid);
if (cg_obj == NULL) {
rc = MLU_STATUS_NOENT;
MLU_TRACE(TL_ERR, "xid:0x%x failed to access CG "
OID_FMT"\n", xid, OBJ_ID(argp->cg_oid));
goto destroy_cg_exit;
}
grpmgr_member_iter_init(xid, cg_obj, &iter);
do {
member = grpmgr_member_iter_next_member(&iter);
if (member == NULL) {
break;
}
rc = grpmgr_remove_member(xid, cg_obj, member);
if (rc != 0) {
MLU_TRACE(TL_ERR, "xid:0x%x failed to remove "
"member "OID_FMT", rc:0x%x\n",
xid, OBJ_ID(OBJ_OID(member)), rc);
}
} while (true);
rc = obj_destroy(xid, cg_obj);
if (rc != 0) {
MLU_TRACE(TL_ERR, "xid:0x%x failed to destroy CG "
OID_FMT", rc:0x%x\n",
xid, OBJ_ID(argp->cg_oid), rc);
obj_fail(xid, cg_obj, rc);
}
destroy_cg_exit:
return rc;
}
/*
* Destroys an entire subtree, from bottom to top
*/
static int
objP_tree_do_destroy(ABObj obj)
{
int iReturn= 0;
int iRC= 0; /* return code */
ABObj doomedChild = NULL;
if (obj == NULL)
{
goto epilogue;
}
/*
* Queue all the events, because destroying as we go
* can get messy.
*/
while (obj_has_child(obj))
{
doomedChild = obj_get_child(obj, 0);
if ((iRC= obj_destroy(doomedChild)) < 0)
{
iReturn= iRC;
goto epilogue;
}
}
/*
* we have no children at this point
*/
iRC= obj_destroy_one(obj);
if ((iRC < 0) && (iRC != ERR_MULTIPLE_FREE))
{
iReturn= iRC;
}
epilogue:
return iReturn;
}
void list_destroy(list_t **list)
{
list_t *obj = *list;
uint16_t i = 0;
for (i = 0; i<obj->size;i++)
if (obj->value[i])
{
#ifdef DEBUG
if (obj->value[i]->type == OBJ_STRING)
printf("[destroy] list: index=[%d] '%s'\n", obj->size, obj->value[i]->value);
if (obj->value[i]->type == OBJ_INTEGER)
printf("[destroy] list: index=[%d] '%d'\n", obj->size, *(uint32_t*)obj->value[i]->value);
#endif
obj_destroy(&obj->value[i]);
}
free(obj->value);
free(obj);
*list = NULL;
}
/* Read a single sexp from the reader. */
object_t *read_sexp (reader_t * r)
{
/* Check for a shebang line. */
if (r->shebang == -1)
{
char str[2];
str[0] = reader_getc (r);
str[1] = reader_getc (r);
if (str[0] == '#' && str[1] == '!')
{
/* Looks like a she-bang line. */
r->shebang = 1;
consume_line (r);
}
else
{
r->shebang = 0;
reader_putc (r, str[1]);
reader_putc (r, str[0]);
}
}
r->done = 0;
r->error = 0;
push (r);
print_prompt (r);
while (!r->eof && !r->error && (list_empty (r) || stack_height (r) > 1))
{
int nc, c = reader_getc (r);
switch (c)
{
case EOF:
r->eof = 1;
break;
/* Comments */
case ';':
consume_line (r);
break;
/* Dotted pair */
case '.':
nc = reader_getc (r);
if (strchr (" \t\r\n()", nc) != NULL)
{
if (r->state->dotpair_mode > 0)
read_error (r, "invalid dotted pair syntax");
else if (r->state->vector_mode > 0)
read_error (r, "dotted pair not allowed in vector");
else
{
r->state->dotpair_mode = 1;
reader_putc (r, nc);
}
}
else
{
/* Turn it into a decimal point. */
reader_putc (r, nc);
reader_putc (r, '.');
reader_putc (r, '0');
}
break;
/* Whitespace */
case '\n':
r->linecnt++;
print_prompt (r);
case ' ':
case '\t':
case '\r':
break;
/* Parenthesis */
case '(':
push (r);
break;
case ')':
if (r->state->quote_mode)
read_error (r, "unbalanced parenthesis");
else if (r->state->vector_mode)
read_error (r, "unbalanced brackets");
else
addpop (r);
break;
/* Vectors */
case '[':
push (r);
r->state->vector_mode = 1;
break;
case ']':
if (r->state->quote_mode)
read_error (r, "unbalanced parenthesis");
else if (!r->state->vector_mode)
read_error (r, "unbalanced brackets");
else
addpop (r);
break;
/* Quoting */
case '\'':
push (r);
add (r, quote);
if (!r->error)
r->state->quote_mode = 1;
break;
/* strings */
case '"':
buf_read (r, "\"");
add (r, parse_str (r));
reader_getc (r); /* Throw away other quote. */
break;
/* numbers and symbols */
default:
buf_append (r, c);
buf_read (r, " \t\r\n()[];");
object_t *o = parse_atom (r);
if (!r->error)
add (r, o);
break;
}
}
if (!r->eof && !r->error)
consume_whitespace (r);
if (r->error)
return err_symbol;
/* Check state */
r->done = 1;
if (stack_height (r) > 1 || r->state->quote_mode
|| r->state->dotpair_mode == 1)
{
read_error (r, "premature end of file");
return err_symbol;
}
if (list_empty (r))
{
obj_destroy (pop (r));
return NIL;
}
object_t *wrap = pop (r);
object_t *sexp = UPREF (CAR (wrap));
obj_destroy (wrap);
return sexp;
}
