src/pmc/coroutine.pmc

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/coroutine.pmc - Co-Routine PMC
   8
   9 =head1 DESCRIPTION
  10
  11 C<Coroutine> extends C<Continuation> to provide a subroutine that can
  12 stop in the middle, and start back up later at the point at which it
  13 stopped. See the L<Glossary|docs/glossary.pod> for more information.
  14
  15 =head2 Flags
  16
  17 =over 4
  18
  19 =item private0 call flip flop
  20
  21 =item private3 restore current sub after "flop".  Used by generators.
  22
  23 =back
  24
  25 =head2 Methods
  26
  27 =over 4
  28
  29 =cut
  30
  31 */
  32
  33 #include "parrot/parrot.h"
  34 #include "parrot/oplib/ops.h"
  35
  36 static void
  37 print_sub_name(PARROT_INTERP, PMC *sub)
  38 {
  39     Parrot_coro * const co     = PMC_coro(sub);
  40     Interp      * const tracer = interp->debugger ? interp->debugger : interp;
  41
  42     PIO_eprintf(tracer, "# %s coro '%Ss'",
  43         !(PObj_get_FLAGS(sub) & SUB_FLAG_CORO_FF) ?
  44         "Calling" : "yielding from",
  45         Parrot_full_sub_name(interp, sub));
  46
  47     if (co->ctx && (PObj_get_FLAGS(sub) & SUB_FLAG_CORO_FF)) {
  48         PIO_eprintf(tracer, " to '%Ss'",
  49                 Parrot_full_sub_name(interp,
  50                     co->ctx->caller_ctx->current_sub));
  51     }
  52
  53     PIO_eprintf(tracer, "\n# ");
  54     print_pbc_location(interp);
  55 }
  56
  57 pmclass Coroutine extends Sub need_ext {
  58
  59 /*
  60
  61 =item C<void init()>
  62
  63 Initializes the co-routine.
  64
  65 =item C<PMC *clone()>
  66
  67 Clone the couroutine.
  68
  69 =cut
  70
  71 */
  72
  73     VTABLE void init() {
  74         PMC_struct_val(SELF) = new_coroutine(INTERP);
  75         PMC_pmc_val(SELF)    = PMCNULL;
  76         PObj_custom_mark_destroy_SETALL(SELF);
  77     }
  78
  79 /*
  80
  81 =item C<void destroy()>
  82
  83 Destroys the coroutine.
  84
  85 =cut
  86
  87 */
  88
  89     VTABLE void destroy() {
  90         Parrot_coro * const sub = PMC_coro(SELF);
  91
  92         if (sub->ctx)
  93             Parrot_free_context(interp, sub->ctx, 0);
  94
  95         SUPER();
  96     }
  97
  98     VTABLE PMC *clone() {
  99         Parrot_coro * const sub = mem_allocate_typed(Parrot_coro);
 100         PMC         * const ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
 101
 102         PObj_custom_mark_destroy_SETALL(ret);
 103
 104         PMC_struct_val(ret) = sub;
 105         PMC_pmc_val(ret)    = PMCNULL;
 106
 107         memcpy(sub, PMC_sub(SELF), sizeof (Parrot_coro));
 108
 109         sub->name           = string_copy(INTERP, sub->name);
 110
 111         return ret;
 112     }
 113
 114 /*
 115
 116 =item C<opcode_t *invoke(void *next)>
 117
 118 Swaps the "context".
 119
 120 =cut
 121
 122 */
 123
 124     VTABLE opcode_t *invoke(void *next) {
 125         PackFile_ByteCode  *wanted_seg;
 126         Parrot_coro * const co = PMC_coro(SELF);
 127         opcode_t    * dest     = co->address;
 128
 129         if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
 130             print_sub_name(INTERP, SELF);
 131
 132         if (!co->ctx) {
 133             parrot_context_t *caller_ctx;
 134             parrot_context_t *ctx;
 135             PMC *ccont;
 136
 137             /* RT#46699 factor out common code with Sub.invoke and inherit it */
 138             ccont = INTERP->current_cont;
 139
 140             if (ccont == NEED_CONTINUATION)
 141                 ccont = (PMC *)new_ret_continuation_pmc(interp,
 142                                                        (opcode_t *)next);
 143
 144             if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL)
 145                 real_exception(INTERP, NULL, E_Exception,
 146                         "tail call to coro not allowed");
 147
 148             /* first time set current sub, cont, object */
 149             caller_ctx = CONTEXT(interp);
 150             ctx        = Parrot_alloc_context(INTERP, co->n_regs_used);
 151
 152             co->ctx                   = ctx;
 153             co->dynamic_state         = interp->dynamic_env;
 154
 155             ctx->caller_ctx           = caller_ctx;
 156             PMC_cont(ccont)->from_ctx = ctx;
 157             ctx->current_sub          = SELF;
 158             ctx->current_HLL          = co->HLL_id;
 159             ctx->current_namespace    = co->namespace_stash;
 160             ctx->current_cont         = ccont;
 161             ctx->current_object       = NULL;
 162             INTERP->current_object    = NULL;
 163             INTERP->current_cont      = NULL;
 164
 165             /* create pad if needed */
 166             if (!PMC_IS_NULL(co->lex_info)) {
 167                 ctx->lex_pad = pmc_new_init(INTERP,
 168                         Parrot_get_ctx_HLL_type(interp, enum_class_LexPad),
 169                         co->lex_info);
 170                 VTABLE_set_pointer(INTERP, ctx->lex_pad, ctx);
 171             }
 172
 173             PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
 174             wanted_seg            = co->seg;
 175             co->caller_seg        = INTERP->code;
 176             co->address           = co->seg->base.data + co->start_offs;
 177         }
 178
 179         /* if calling the Coro we need the segment of the Coro */
 180         else if (!(PObj_get_FLAGS(SELF) & SUB_FLAG_CORO_FF)) {
 181             PMC *ccont;
 182             Stack_Chunk_t    *state;
 183             parrot_context_t *ctx;
 184
 185             PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
 186             wanted_seg            = co->seg;
 187
 188             /* remember segment of caller */
 189             co->caller_seg        = INTERP->code;
 190             ctx                   = co->ctx;
 191
 192             /* and the recent call context */
 193             ccont                 = ctx->current_cont;
 194             ctx->caller_ctx       = PMC_cont(ccont)->to_ctx
 195                                   = CONTEXT(interp);
 196
 197             /* set context to coro context */
 198             state                 = interp->dynamic_env;
 199             interp->dynamic_env   = co->dynamic_state;
 200             co->dynamic_state     = state;
 201             CONTEXT(interp)       = ctx;
 202             INTERP->ctx.bp        = ctx->bp;
 203             INTERP->ctx.bp_ps     = ctx->bp_ps;
 204         }
 205         else {
 206             PMC *ccont;
 207             Stack_Chunk_t    *state;
 208             parrot_context_t *ctx;
 209
 210             PObj_get_FLAGS(SELF) &= ~SUB_FLAG_CORO_FF;
 211             /* switch back to last remembered code seg and context */
 212
 213             wanted_seg            = co->caller_seg;
 214             ccont                 = co->ctx->current_cont;
 215             ctx                   = PMC_cont(ccont)->to_ctx;
 216
 217             if (! ctx) {
 218                 /* This still isn't quite right, but it beats segfaulting.  See
 219                    the "Call an exited coroutine" case in t/pmc/coroutine.t; the
 220                    problem is that the defunct coroutine yields up one more
 221                    result before we get here.  -- rgr, 7-Oct-06.
 222                 */
 223                 real_exception(INTERP, NULL, E_Exception,
 224                                "Cannot resume dead coroutine.");
 225             }
 226
 227             state                = interp->dynamic_env;
 228             interp->dynamic_env  = co->dynamic_state;
 229             co->dynamic_state    = state;
 230             CONTEXT(interp)      = ctx;
 231             INTERP->ctx.bp       = ctx->bp;
 232             INTERP->ctx.bp_ps    = ctx->bp_ps;
 233         }
 234
 235         /* toggle address */
 236         dest        = co->address;
 237         co->address = (opcode_t *)next;
 238
 239         if (INTERP->code != wanted_seg)
 240             Parrot_switch_to_cs(INTERP, wanted_seg, 1);
 241
 242         return dest;
 243     }
 244
 245 /*
 246
 247 =item C<void mark()>
 248
 249 Marks the coroutine as live.
 250
 251 =cut
 252
 253 */
 254
 255     VTABLE void mark() {
 256         Parrot_coro * const co = PMC_coro(SELF);
 257
 258         if (co) {
 259             if (co->ctx)
 260                 mark_context(INTERP, co->ctx);
 261             if (co->dynamic_state)
 262                 mark_stack(INTERP, co->dynamic_state);
 263
 264         }
 265
 266         SUPER();
 267     }
 268 }
 269
 270 /*
 271
 272 =back
 273
 274 =cut
 275
 276 */
 277
 278 /*
 279  * Local variables:
 280  *   c-file-style: "parrot"
 281  * End:
 282  * vim: expandtab shiftwidth=4:
 283  */