Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

399 lines (282 sloc) 11.471 kB
/*
Copyright (C) 2001-2014, Parrot Foundation.
=head1 NAME
src/pmc/coroutine.pmc - Coroutine PMC
=head1 DESCRIPTION
C<Coroutine> extends C<Sub> to provide a subroutine that can
stop in the middle, and start back up later at the point at which it
stopped. See the L<Glossary|docs/glossary.pod> for more information.
=head2 Flags
=over 4
=item private0 call flip flop
=item private3 restore current sub after "flop". Used by generators.
=back
=head2 Methods
=over 4
=cut
*/
#include "parrot/oplib/ops.h"
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
static void print_sub_name(PARROT_INTERP, ARGIN(PMC *sub_pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
#define ASSERT_ARGS_print_sub_name __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(sub_pmc))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
#ifdef NDEBUG
# define TRACE_CORO(s)
# define TRACE_CORO_1(s, arg)
#else
# define TRACE_CORO(s) \
if (Interp_trace_TEST(interp, PARROT_TRACE_CORO_STATE_FLAG)) \
fprintf(stderr, (s))
# define TRACE_CORO_1(s, arg) \
if (Interp_trace_TEST(interp, PARROT_TRACE_CORO_STATE_FLAG)) \
fprintf(stderr, (s), (arg))
#endif
/*
=item C<static void print_sub_name(PARROT_INTERP, PMC *sub_pmc)>
static function to print coroutine information (for tracing/debugging)
=cut
*/
static void
print_sub_name(PARROT_INTERP, ARGIN(PMC *sub_pmc))
{
/* It's actually a Parrot_coroutine, but this avoids casting warnings. */
PMC *ctx;
INTVAL yield;
Interp * const tracer = (interp->pdb && interp->pdb->debugger) ?
interp->pdb->debugger :
interp;
GETATTR_Coroutine_ctx(interp, sub_pmc, ctx);
GETATTR_Coroutine_yield(interp, sub_pmc, yield);
if (!yield && (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_CORO_FF))
Parrot_io_eprintf(tracer, "# %s coroutine '%Ss'",
"returning from",
Parrot_sub_full_sub_name(interp, sub_pmc));
else
Parrot_io_eprintf(tracer, "# %s coroutine '%Ss'",
!(PObj_get_FLAGS(sub_pmc) & SUB_FLAG_CORO_FF) ?
"Calling" : "yielding from",
Parrot_sub_full_sub_name(interp, sub_pmc));
if (!PMC_IS_NULL(ctx) && (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_CORO_FF)) {
Parrot_io_eprintf(tracer, " to '%Ss'",
Parrot_sub_full_sub_name(interp,
Parrot_pcc_get_sub(interp, Parrot_pcc_get_caller_ctx(interp, ctx))));
}
Parrot_io_eprintf(tracer, "\n# ");
Parrot_print_pbc_location(interp);
}
pmclass Coroutine extends Sub provides invokable auto_attrs {
ATTR INTVAL yield; /* yield in process */
ATTR INTVAL autoreset; /* die or autoreset? */
ATTR opcode_t *address; /* next address to run - toggled each time */
ATTR PackFile_ByteCode *caller_seg; /* bytecode segment */
/*
=item C<void init()>
Initializes the coroutine.
=cut
*/
VTABLE void init() {
SET_ATTR_ctx(INTERP, SELF, PMCNULL);
SUPER();
}
/*
=item C<PMC * clone()>
Clones the coroutine.
=cut
*/
VTABLE PMC *clone() :no_wb {
PMC * const ret = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
PObj_custom_mark_destroy_SETALL(ret);
/* first copy the struct, Parrot_str_copy may cause GC */
memcpy((Parrot_Coroutine_attributes *)PMC_data(ret),
(Parrot_Coroutine_attributes *)PMC_data(SELF),
sizeof (Parrot_Coroutine_attributes));
/* but unlike with Sub we do share the arg_info struct */
PObj_flags_SETTO(ret, PObj_get_FLAGS(SELF) & ~PObj_GC_all_FLAGS);
return ret;
}
/*
=item C<void mark()>
Marks all GC-able pmc elements as live.
=cut
*/
VTABLE void mark() :no_wb {
Parrot_Coroutine_attributes * const coro = PARROT_COROUTINE(SELF);
if (!coro)
return;
if (coro->caller_seg && ! Interp_flags_TEST(interp, PARROT_IS_THREAD)) {
Parrot_gc_mark_PMC_alive(INTERP, coro->caller_seg->base.pf->view);
}
SUPER();
}
/*
=item C<void increment()>
Signals the start of a yield.
=cut
*/
VTABLE void increment() {
SET_ATTR_yield(INTERP, SELF, 1);
}
/*
=item C<void reset()>
Resets the state of the coroutine, so that the next call will start at the
first yield again.
=cut
*/
METHOD void reset() {
TRACE_CORO("# coro: reset ff\n");
SET_ATTR_ctx(INTERP, SELF, PMCNULL);
INTERP->current_cont = PMCNULL;
}
/*
=item C<void autoreset()>
Sets a coroutine to auto-resetting, so it will never die when all yield
states are exhausted. You can use autoreset(0) to turn it off again.
Use this with care, as it might not do what you want!
=cut
*/
METHOD void autoreset(INTVAL set :optional, INTVAL have_set :opt_flag) {
INTVAL value = 1;
if (have_set)
value = set;
#ifndef NDEBUG
if (Interp_trace_TEST(INTERP, PARROT_TRACE_CORO_STATE_FLAG)) {
if (have_set)
fprintf(stderr, "# coro: autoreset %ld\n", value);
else
fprintf(stderr, "# coro: autoreset\n");
}
#endif
SET_ATTR_autoreset(INTERP, SELF, value);
}
/*
=item C<opcode_t *invoke(void *next)>
Swaps the "context" between the call to the coro and the yield back, until all
yields are exhausted and the coro is dead.
=cut
*/
VTABLE opcode_t *invoke(void *next) :no_wb {
PMC *ctx;
opcode_t *dest;
PackFile_ByteCode *wanted_seg;
PMC * const signature = Parrot_pcc_get_signature(INTERP,
CURRENT_CONTEXT(INTERP));
#ifndef NDEBUG
if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
print_sub_name(INTERP, SELF);
#endif
GET_ATTR_ctx(INTERP, SELF, ctx);
if (PMC_IS_NULL(ctx)) {
PackFile_ByteCode *seg;
size_t start_offs;
const UINTVAL *n_regs_used;
PMC *lex_info;
PMC * const caller_ctx = CURRENT_CONTEXT(INTERP);
PMC *ccont = INTERP->current_cont;
PARROT_ASSERT(!PMC_IS_NULL(ccont));
ctx = Parrot_pcc_get_signature(INTERP, caller_ctx);
if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL)
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
"tail call to coroutine not allowed");
/* first time set current sub, cont, object */
if (PMC_IS_NULL(ctx))
ctx = Parrot_pmc_new(INTERP, enum_class_CallContext);
TRACE_CORO("# - coro: first ctx\n");
Parrot_pcc_set_context(INTERP, ctx);
GET_ATTR_n_regs_used(INTERP, SELF, n_regs_used);
Parrot_pcc_allocate_registers(INTERP, ctx, n_regs_used);
Parrot_pcc_set_caller_ctx(INTERP, ctx, caller_ctx);
Parrot_pcc_init_context(INTERP, ctx, caller_ctx);
SET_ATTR_ctx(INTERP, SELF, ctx);
SETATTR_Continuation_from_ctx(INTERP, ccont, ctx);
Parrot_pcc_set_sub(INTERP, ctx, SELF);
Parrot_pcc_set_continuation(INTERP, ctx, ccont);
INTERP->current_cont = PMCNULL;
GET_ATTR_lex_info(INTERP, SELF, lex_info);
/* create pad if needed */
if (!PMC_IS_NULL(lex_info)) {
const INTVAL hlltype = Parrot_hll_get_ctx_HLL_type(INTERP, enum_class_LexPad);
PMC * const lexpad = Parrot_pmc_new_init(INTERP, hlltype, lex_info);
Parrot_pcc_set_lex_pad(INTERP, ctx, lexpad);
VTABLE_set_pointer(INTERP, lexpad, ctx);
}
GET_ATTR_seg(INTERP, SELF, seg);
PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
wanted_seg = seg;
GET_ATTR_start_offs(INTERP, SELF, start_offs);
SET_ATTR_caller_seg(INTERP, SELF, INTERP->code);
SET_ATTR_address(INTERP, SELF, seg->base.data + start_offs);
}
/* !FF: call the Coro. we need the segment of the Coro */
else if (!(PObj_get_FLAGS(SELF) & SUB_FLAG_CORO_FF)) {
PackFile_ByteCode *seg;
PMC *ccont;
GET_ATTR_ctx(INTERP, SELF, ctx);
ccont = Parrot_pcc_get_continuation(INTERP, ctx);
TRACE_CORO("# - coro: !ff\n");
PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
GET_ATTR_seg(INTERP, SELF, seg);
wanted_seg = seg;
/* remember segment of caller */
SET_ATTR_caller_seg(INTERP, SELF, INTERP->code);
/* and the recent call context */
SETATTR_Continuation_to_ctx(INTERP, ccont, CURRENT_CONTEXT(INTERP));
Parrot_pcc_set_caller_ctx(INTERP, ctx, CURRENT_CONTEXT(INTERP));
/* set context to coroutine context */
Parrot_pcc_set_context(INTERP, ctx);
}
else { /* FF: yield or returncc from the Coro back */
INTVAL yield;
PMC *ccont, *to_ctx;
PackFile_ByteCode *caller_seg;
GET_ATTR_yield(INTERP, SELF, yield);
TRACE_CORO_1("# - coro: ff (yield=%ld)\n", yield);
if (!yield) {
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
"Cannot resume dead coroutine");
}
SET_ATTR_yield(INTERP, SELF, 0);
GET_ATTR_ctx(INTERP, SELF, ctx);
ccont = Parrot_pcc_get_continuation(INTERP, ctx);
GETATTR_Continuation_to_ctx(INTERP, ccont, to_ctx);
PObj_get_FLAGS(SELF) &= ~SUB_FLAG_CORO_FF;
GET_ATTR_caller_seg(INTERP, SELF, caller_seg);
/* switch back to last remembered code seg and context */
wanted_seg = caller_seg;
if (PMC_IS_NULL(to_ctx)) {
/* This still isn't quite right, but it beats segfaulting. See
the "Call an exited coroutine" case in t/pmc/coroutine.t; the
problem is that the defunct coroutine yields up one more
result before we get here. -- rgr, 7-Oct-06.
* This may be unneeded after the yield fix, see TT #1003
*/
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
"Cannot resume dead coroutine. Invalid context");
}
Parrot_pcc_set_context(INTERP, to_ctx);
}
Parrot_pcc_set_signature(INTERP, CURRENT_CONTEXT(INTERP), signature);
/* toggle address */
GET_ATTR_address(INTERP, SELF, dest);
SET_ATTR_address(INTERP, SELF, (opcode_t *)next);
if (INTERP->code != wanted_seg)
Parrot_pf_switch_to_cs(INTERP, wanted_seg, 1);
return dest;
}
}
/*
=back
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
*/
Jump to Line
Something went wrong with that request. Please try again.