Beispiel #1
0
/* 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;
}
Beispiel #2
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;
}
Beispiel #3
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;
}
Beispiel #4
0
/* 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;
}