/* load executable name */
static
int evalload(Xpost_Context *ctx)
{
int ret;
if (_xpost_interpreter_is_tracing)
{
Xpost_Object s = xpost_name_get_string(ctx, xpost_stack_topdown_fetch(ctx->lo, ctx->es, 0));
XPOST_LOG_DUMP("evalload <name \"%*s\">", s.comp_.sz, xpost_string_get_pointer(ctx, s));
}
if (!xpost_stack_push(ctx->lo, ctx->os,
xpost_stack_pop(ctx->lo, ctx->es)))
return stackoverflow;
assert(ctx->gl->base);
/*xpost_operator_exec(ctx, xpost_operator_cons(ctx, "load", NULL,0,0).mark_.padw); */
ret = xpost_operator_exec(ctx, ctx->opcode_shortcuts.load);
if (ret)
return ret;
if (xpost_object_is_exe(xpost_stack_topdown_fetch(ctx->lo, ctx->os, 0)))
{
Xpost_Object q;
q = xpost_stack_pop(ctx->lo, ctx->os);
if (xpost_object_get_type(q) == invalidtype)
return undefined;
if (!xpost_stack_push(ctx->lo, ctx->es, q))
return ret;
}
return 0;
}
/* obj xcheck bool
test executable attribute in obj */
static
int Axcheck(Xpost_Context *ctx,
Xpost_Object o)
{
xpost_stack_push(ctx->lo, ctx->os, xpost_bool_cons(xpost_object_is_exe(o)));
return 0;
}
/*
one iteration of the central loop
called repeatedly by mainloop()
*/
int eval(Xpost_Context *ctx)
{
int ret;
Xpost_Object t = xpost_stack_topdown_fetch(ctx->lo, ctx->es, 0);
ctx->currentobject = t; /* for _onerror to determine if hold stack contents are restoreable.
if opexec(opcode) discovers opcode != ctx->currentobject.mark_.padw
it sets a flag indicating the hold stack does not contain
ctx->currentobject's arguments.
if an error is encountered, currentobject is reported as the
errant object since it is the "entry point" to the interpreter.
*/
if (!validate_context(ctx))
return unregistered;
if (_xpost_interpreter_is_tracing)
{
XPOST_LOG_DUMP("eval(): Executing: ");
xpost_object_dump(t);
XPOST_LOG_DUMP("Stack: ");
xpost_stack_dump(ctx->lo, ctx->os);
XPOST_LOG_DUMP("Dict Stack: ");
xpost_stack_dump(ctx->lo, ctx->ds);
XPOST_LOG_DUMP("Exec Stack: ");
xpost_stack_dump(ctx->lo, ctx->es);
}
ret = idleproc(ctx); /* periodically process asynchronous events */
if (ret)
return ret;
{ /* check object for sanity before using jump table */
Xpost_Object_Type type = xpost_object_get_type(t);
if (type == invalidtype || type >= XPOST_OBJECT_NTYPES)
return unregistered;
}
if ( xpost_object_is_exe(t) ) /* if executable */
ret = evaltype[xpost_object_get_type(t)](ctx);
else
ret = evalpush(ctx);
return ret;
}
/* string cvn name
convert string to name */
static
int Scvn(Xpost_Context *ctx,
Xpost_Object s)
{
char *t;
Xpost_Object name;
t = alloca(s.comp_.sz+1);
memcpy(t, xpost_string_get_pointer(ctx, s), s.comp_.sz);
t[s.comp_.sz] = '\0';
name = xpost_name_cons(ctx, t);
if (xpost_object_get_type(name) == invalidtype)
return VMerror;
if (xpost_object_is_exe(s))
name = xpost_object_cvx(name);
else
name = xpost_object_cvlit(name);
xpost_stack_push(ctx->lo, ctx->os, name);
return 0;
}