/* 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; }