parrotcode: Parrot Interpreter - Run Ops and Methods | |
Contents | C |
src/inter_run.c - Parrot Interpreter - Run Ops and Methods
Various functions that call the run loop.
*/
#include "parrot/parrot.h" #include "parrot/oplib/ops.h"
/* HEADERIZER HFILE: include/parrot/interpreter.h */
/* HEADERIZER BEGIN: static */
PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static parrot_context_t * runops_args( PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(PMC *obj), SHIM(STRING *meth), NOTNULL(const char *sig), va_list ap ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(5);
/* HEADERIZER END: static */
#define STACKED_EXCEPTIONS 1 /* #define RUNLOOP_TRACE 1 */
static int runloop_id_counter = 0; /* for synthesizing runloop ids. */
/*
FUNCDOC: runops
Run parrot ops. Set exception handler and/or resume after exception.
*/
void runops(PARROT_INTERP, size_t offs) { volatile size_t offset = offs; const int old_runloop_id = interp->current_runloop_id; const int our_runloop_level = ++interp->current_runloop_level; const int our_runloop_id = ++runloop_id_counter;
/* It is OK if the runloop ID overflows; we only ever test it for equality,
so the chance of collision is slight. */
interp->current_runloop_id = our_runloop_id;
#ifdef RUNLOOP_TRACE
fprintf(stderr, "[entering loop %d, level %d]\n",
interp->current_runloop_id, our_runloop_level);
#endif
/*
* STACKED_EXCEPTIONS are necessary to catch exceptions in reentered
* run loops, e.g. if a delegate methods throws an exception
*/
#if ! STACKED_EXCEPTIONS
if (!interp->exceptions)
#endif
{
new_internal_exception(interp);
if (setjmp(interp->exceptions->destination)) {
/* an exception was thrown */
interp->current_runloop_level = our_runloop_level;
interp->current_runloop_id = our_runloop_id;
#ifdef RUNLOOP_TRACE
fprintf(stderr, "[exception; back to loop %d, level %d]\n",
our_runloop_id, our_runloop_level);
#endif
offset = handle_exception(interp);
/* update profile for exception execution time */
if (interp->profile &&
Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) {
RunProfile *profile = interp->profile;
if (profile->cur_op == PARROT_PROF_EXCEPTION) {
profile->data[PARROT_PROF_EXCEPTION].time +=
Parrot_floatval_time() - profile->starttime;
}
}
}
}
runops_int(interp, offset);
/*
* pop off exception and put it onto the free list
* s. above
*/
if (STACKED_EXCEPTIONS) {
free_internal_exception(interp);
}
#ifdef RUNLOOP_TRACE
fprintf(stderr, "[exiting loop %d, level %d]\n",
our_runloop_id, our_runloop_level);
#endif
interp->current_runloop_level = our_runloop_level - 1;
interp->current_runloop_id = old_runloop_id;
/*
* not yet - this needs classifying of exceptions and handlers
* so that only an exit handler does catch this exception
*/
#if 0
do_exception(interp, EXCEPT_exit, 0);
#endif
}
/*
FUNCDOC: Parrot_runops_fromc
Runs the Parrot ops, called from C code. The function arguments are already setup according to Parrot calling conventions, the sub
argument is an invocable Sub
PMC.
*/
PARROT_API PARROT_IGNORABLE_RESULT PARROT_CANNOT_RETURN_NULL parrot_context_t * Parrot_runops_fromc(PARROT_INTERP, NOTNULL(PMC *sub)) { opcode_t offset, *dest; parrot_context_t *ctx;
/* we need one return continuation with a NULL offset */
PMC * const ret_c = new_ret_continuation_pmc(interp, NULL);
interp->current_cont = ret_c;
#if defined GC_VERBOSE && GC_VERBOSE
PObj_report_SET(ret_c); /* s. also dod.c */
#endif
/* invoke the sub, which places the context of the sub in the
* interpreter, and switches code segments if needed
* Passing a dummy true destination copies registers
*/
dest = VTABLE_invoke(interp, sub, (void*) 1);
if (!dest)
real_exception(interp, NULL, 1, "Subroutine returned a NULL address");
ctx = CONTEXT(interp->ctx);
offset = dest - interp->code->base.data;
runops(interp, offset);
return ctx;
}
PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static parrot_context_t * runops_args(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(PMC *obj), SHIM(STRING *meth), NOTNULL(const char *sig), va_list ap) { opcode_t offset, *dest; parrot_context_t *ctx;
char new_sig[10];
const char *sig_p;
parrot_context_t * const old_ctx = CONTEXT(interp->ctx);
interp->current_cont = new_ret_continuation_pmc(interp, NULL);
interp->current_object = obj;
dest = VTABLE_invoke(interp, sub, NULL);
if (!dest) {
real_exception(interp, NULL, 1, "Subroutine returned a NULL address");
}
if (PMC_IS_NULL(obj)) {
/* skip over the return type */
sig_p = sig + 1;
}
else if (sig[1] == 'O') {
/* skip over the return type */
sig_p = sig + 1;
}
else {
const size_t len = strlen(sig);
if (len > 8) {
real_exception(interp, NULL, 1, "too many arguments in runops_args");
}
new_sig[0] = 'O';
strcpy(new_sig + 1, sig + 1);
sig_p = new_sig;
}
if (*sig_p && dest[0] == PARROT_OP_get_params_pc) {
dest = parrot_pass_args_fromc(interp, sig_p, dest, old_ctx, ap);
}
/*
* main is now started with runops_args_fromc too
* PASM subs usually don't have get_params
* XXX we could check, if we are running main
else {
real_exception(interp, NULL, E_ValueError, "no get_params in sub");
}
*/
ctx = CONTEXT(interp->ctx);
offset = dest - interp->code->base.data;
runops(interp, offset);
return ctx;
}
/*
FUNCDOC: Parrot_run_meth_fromc
Run a method sub from C. The function arguments are already setup according to Parrot calling conventions, the sub
argument is an invocable Sub
PMC.
If registers a PMC return values, it is returned.
Run parrot ops, called from C code, function arguments are passed as va_args
according to the signature. The sub
argument is an invocable Sub
PMC.
Signatures are similar to NCI:
v ... void return
I ... INTVAL (not Interpreter)
N ... NUMVAL
S ... STRING*
P ... PMC*
*/
PARROT_API PARROT_IGNORABLE_RESULT PARROT_CAN_RETURN_NULL void * Parrot_run_meth_fromc(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(PMC *obj), SHIM(STRING *meth)) { parrot_context_t *ctx; opcode_t offset, *dest;
interp->current_cont = new_ret_continuation_pmc(interp, NULL);
interp->current_object = obj;
dest = VTABLE_invoke(interp, sub, (void*)1);
if (!dest)
real_exception(interp, NULL, 1, "Subroutine returned a NULL address");
ctx = CONTEXT(interp->ctx);
offset = dest - interp->code->base.data;
runops(interp, offset);
return set_retval(interp, 0, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT PARROT_CAN_RETURN_NULL PMC * Parrot_runops_fromc_args(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(const char *sig), ...) { va_list args; parrot_context_t *ctx;
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
return (PMC *)set_retval(interp, *sig, ctx);
}
/*
FUNCDOC: Parrot_runops_fromc_args_event
Run code from within event handlers. This variant deals with some reentrency issues. It also should do sanity checks, if e.g. the handler subroutine didn't return properly.
*/
PARROT_API PARROT_IGNORABLE_RESULT PARROT_CAN_RETURN_NULL void * Parrot_runops_fromc_args_event(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(const char *sig), ...) { va_list args; parrot_context_t *ctx; void *retval; /* * running code from event handlers isn't fully reentrant due to * these interpreter variables - mainly related to calls */ opcode_t * const cargs = interp->current_args; opcode_t * const params = interp->current_params; opcode_t * const returns = interp->current_returns; PMC * const cont = interp->current_cont; /* what else ? */
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
retval = set_retval(interp, *sig, ctx);
interp->current_args = cargs;
interp->current_params = params;
interp->current_returns = returns;
interp->current_cont = cont;
return retval;
}
PARROT_API PARROT_IGNORABLE_RESULT INTVAL Parrot_runops_fromc_args_reti(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(const char *sig), ...) { va_list args; parrot_context_t *ctx;
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
return set_retval_i(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT FLOATVAL Parrot_runops_fromc_args_retf(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(const char *sig), ...) { va_list args; parrot_context_t *ctx;
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
return set_retval_f(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT PARROT_CAN_RETURN_NULL void* Parrot_run_meth_fromc_args(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(PMC *obj), NOTNULL(STRING *meth), NOTNULL(const char *sig), ...) { va_list args; parrot_context_t *ctx;
va_start(args, sig);
ctx = runops_args(interp, sub, obj, meth, sig, args);
va_end(args);
return set_retval(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT INTVAL Parrot_run_meth_fromc_args_reti(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(PMC *obj), NOTNULL(STRING *meth), NOTNULL(const char *sig), ...) { va_list args; parrot_context_t *ctx;
va_start(args, sig);
ctx = runops_args(interp, sub, obj, meth, sig, args);
va_end(args);
return set_retval_i(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT FLOATVAL Parrot_run_meth_fromc_args_retf(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(PMC *obj), NOTNULL(STRING *meth), NOTNULL(const char *sig), ...) { va_list args; parrot_context_t *ctx;
va_start(args, sig);
ctx = runops_args(interp, sub, obj, meth, sig, args);
va_end(args);
return set_retval_f(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT PARROT_CAN_RETURN_NULL void * Parrot_runops_fromc_arglist(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(const char *sig), va_list args) { parrot_context_t * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
return set_retval(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT INTVAL Parrot_runops_fromc_arglist_reti(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(const char *sig), va_list args) { parrot_context_t * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
return set_retval_i(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT FLOATVAL Parrot_runops_fromc_arglist_retf(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(const char *sig), va_list args) { parrot_context_t * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
return set_retval_f(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT PARROT_CAN_RETURN_NULL void* Parrot_run_meth_fromc_arglist(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(PMC *obj), NOTNULL(STRING *meth), NOTNULL(const char *sig), va_list args) { parrot_context_t *ctx;
ctx = runops_args(interp, sub, obj, meth, sig, args);
return set_retval(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT PARROT_CAN_RETURN_NULL INTVAL Parrot_run_meth_fromc_arglist_reti(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(PMC *obj), NOTNULL(STRING *meth), NOTNULL(const char *sig), va_list args) { parrot_context_t * const ctx = runops_args(interp, sub, obj, meth, sig, args);
return set_retval_i(interp, *sig, ctx);
}
PARROT_API PARROT_IGNORABLE_RESULT FLOATVAL Parrot_run_meth_fromc_arglist_retf(PARROT_INTERP, NOTNULL(PMC *sub), NOTNULL(PMC *obj), NOTNULL(STRING *meth), NOTNULL(const char *sig), va_list args) { parrot_context_t * const ctx = runops_args(interp, sub, obj, meth, sig, args); return set_retval_f(interp, *sig, ctx); }
/*
include/parrot/interpreter.h, src/interpreter.c.
*/
/* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */
|