src/pmc/continuation.pmc

   1 /*
   2 Copyright (C) 2001-2003, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/continuation.pmc - Continuation PMC
   8
   9 =head1 DESCRIPTION
  10
  11 A C<Continuation> has a copy of the interpreter's context at the location,
  12 where the Continuation was constructed.
  13 See the L<Glossary|docs/glossary.pod> for more information.
  14
  15 =head2 Functions
  16
  17 =over 4
  18
  19 =cut
  20
  21 */
  22
  23
  24 #include "parrot/parrot.h"
  25 #include "parrot/oplib/ops.h"
  26 #include <assert.h>
  27
  28
  29 /*
  30
  31 =back
  32
  33 =head2 Methods
  34
  35 =over 4
  36
  37 =cut
  38
  39 */
  40
  41
  42 /*
  43  * A Continuation (and RetContinuation, Exception_Handler) has in its
  44  * context a pointer to the register frame, which contains active objects.
  45  * Additionally ct->current_cont has he continuation of the caller.
  46  * To avoid deep recursion during marking of nested subroutines, we
  47  * need the next_for_GC pointer in the pmc_ext area.
  48  */
  49
  50 pmclass Continuation need_ext {
  51
  52 /*
  53
  54 =item C<void init()>
  55
  56 Initializes the continuation.
  57
  58 =cut
  59
  60 */
  61
  62     void init () {
  63         PMC_struct_val(SELF) = new_continuation(INTERP, NULL);
  64         PMC_pmc_val(SELF) = NULL;
  65         PObj_custom_mark_destroy_SETALL(SELF);
  66         /* PANIC("don't do that"); */
  67         /*
  68          * Whenever we create a continuation, all return continuations
  69          * up the call chain maybe reused due to invoking the
  70          * continuation. To avoid that all return continuations are
  71          * converted to true continuations.
  72          */
  73         invalidate_retc_context(INTERP, SELF);
  74     }
  75
  76 /*
  77
  78 =item C<void mark()>
  79
  80 Marks the continuation as live.
  81
  82 =cut
  83
  84 */
  85
  86     void mark () {
  87         struct Parrot_cont * cc = PMC_cont(SELF);
  88         if (cc->to_ctx)
  89             mark_context(INTERP, cc->to_ctx);
  90         if (cc->dynamic_state)
  91             mark_register_stack(INTERP, cc->dynamic_state);
  92     }
  93
  94 /*
  95
  96 =item C<void destroy()>
  97
  98 Destroys the continuation.
  99
 100 =cut
 101
 102 */
 103
 104     void destroy () {
 105         struct Parrot_cont * cc = PMC_cont(SELF);
 106         if (cc) {
 107 #if CTX_LEAK_DEBUG
 108             if (Interp_debug_TEST(interpreter, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
 109                 fprintf(stderr,
 110                         "[destroy cont    %p, to_ctx %p, from_ctx %p]\n",
 111                         SELF, cc->to_ctx, cc->from_ctx);
 112             }
 113 #endif
 114             if (cc->from_ctx)
 115                 Parrot_free_context(interpreter, cc->from_ctx, 0);
 116             mem_sys_free(cc);
 117             PMC_struct_val(SELF) = NULL;
 118         }
 119     }
 120 /*
 121
 122 =item C<PMC *clone()>
 123
 124 Creates and returns a clone of the continuation.
 125
 126 =cut
 127
 128 */
 129
 130     PMC* clone() {
 131         struct Parrot_cont * cc;
 132         struct Parrot_cont *cc_self = PMC_cont(SELF);
 133         PMC* ret = pmc_new_noinit(INTERP, enum_class_Continuation);
 134
 135         PObj_custom_mark_destroy_SETALL(ret);
 136         cc = new_continuation(INTERP, cc_self);
 137         cc->runloop_id = cc_self->runloop_id;
 138         cc->dynamic_state = cc_self->dynamic_state;
 139         PMC_struct_val(ret) = cc;
 140         PMC_pmc_val(ret) = PMC_pmc_val(SELF);
 141         return ret;
 142     }
 143
 144 /*
 145
 146 =item C<PMC *set_pmc()>
 147
 148 Assign context.
 149
 150 =cut
 151
 152 */
 153     void set_pmc(PMC* src) {
 154         struct Parrot_cont *cc_self = PMC_cont(SELF);
 155         struct Parrot_cont *cc_src  = PMC_cont(src);
 156
 157         memcpy(cc_self, cc_src, sizeof(struct Parrot_cont));
 158         PMC_pmc_val(SELF) = PMC_pmc_val(src);
 159     }
 160 /*
 161
 162 =item C<void set_pointer(void *value)>
 163
 164 Sets the pointer to the return instruction.
 165
 166 =cut
 167
 168 */
 169
 170     void set_pointer (void* value) {
 171         opcode_t *pos = value;
 172         struct Parrot_cont * cc = PMC_cont(SELF);
 173
 174         PObj_get_FLAGS(SELF) |= PObj_private1_FLAG;
 175         cc->address = value;
 176         cc->dynamic_state = CONTEXT(INTERP->ctx)->control_stack;
 177         cc->runloop_id = INTERP->current_runloop_id;
 178         if (pos && *pos == PARROT_OP_get_results_pc) {
 179             cc->current_results = pos;
 180         }
 181         else
 182             cc->current_results = NULL;
 183     }
 184
 185 /*
 186
 187 =item C<void *get_pointer()>
 188
 189 Returns the pointer to the return instruction.
 190
 191 =cut
 192
 193 */
 194
 195     void* get_pointer () {
 196         return PMC_cont(SELF)->address;
 197     }
 198 /*
 199
 200 =item C<INTVAL defined()>
 201
 202 =item C<INTVAL get_bool()>
 203
 204 Returns whether the subroutine is defined.
 205
 206 =cut
 207
 208 */
 209
 210     INTVAL defined () {
 211         return PMC_cont(SELF)->address != NULL;
 212     }
 213
 214     INTVAL get_bool () {
 215         return PMC_cont(SELF)->address != NULL;
 216     }
 217
 218 /*
 219
 220 =item C<void *invoke(void *next)>
 221
 222 Restores the "context" of the interpreter and returns the branch
 223 destination to continue execution.
 224
 225 =cut
 226
 227 */
 228
 229     void* invoke (void* next) {
 230         struct Parrot_cont * cc = PMC_cont(SELF);
 231         Stack_Chunk_t *stack_target = cc->dynamic_state;
 232         Stack_Chunk_t *corresponding_target;
 233         int stack_delta = 0;
 234         parrot_context_t *from_ctx = CONTEXT(INTERP->ctx);
 235         parrot_context_t *to_ctx   = cc->to_ctx;
 236         opcode_t *pc = cc->address;
 237         /* [bug: these should be 'isa' tests.  -- rgr, 17-Sep-06.] */
 238         int exception_continuation_p
 239             = SELF->vtable->base_type == enum_class_Exception_Handler;
 240         int ret_continuation_p
 241             = SELF->vtable->base_type == enum_class_RetContinuation;
 242
 243         if (interpreter->current_runloop_id != cc->runloop_id
 244             /* it's ok if we are exiting to "runloop 0"; there is no such
 245                runloop, but the only continuation that thinks it came from
 246                runloop 0 is for the return from the initial sub call. */
 247             && cc->runloop_id != 0
 248             /* since a RetContinuation [currently] only returns to the next
 249                outer frame, exiting to the inner run loop does the right thing,
 250                since it normally returns to the next outer runloop anyway.  */
 251             && ! ret_continuation_p) {
 252             fprintf(stderr, "[oops; continuation %p of type %d "
 253                     "is trying to jump from runloop %d to runloop %d]\n",
 254                     SELF, (int) SELF->vtable->base_type,
 255                     interpreter->current_runloop_id, cc->runloop_id);
 256         }
 257 #if CTX_LEAK_DEBUG
 258         if (Interp_debug_TEST(interpreter, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
 259             fprintf(stderr,
 260                     "[invoke cont    %p, to_ctx %p, from_ctx %p (refs %d)]\n",
 261                     SELF, to_ctx, from_ctx, (int) from_ctx->ref_count);
 262         }
 263 #endif
 264         if (! to_ctx) {
 265             real_exception(interpreter, NULL, INVALID_OPERATION,
 266                            "Continuation invoked after deactivation.");
 267         }
 268
 269         /*
 270          * rewind control stack
 271          */
 272         if (from_ctx->control_stack != stack_target) {
 273             /* compute the "stack delta", which is a measure of how much
 274                unwinding we have to do.  if negative, we have to pop that many
 275                entries; if positive, we are going back up the stack.
 276                [bug: this is not true rewinding.  -- rgr, 30-Sep-06.]
 277             */
 278             stack_delta
 279                 = ((int) stack_height(interpreter, stack_target)
 280                    - (int) stack_height(interpreter, from_ctx->control_stack));
 281         }
 282         /* descend down the target stack until we get to the same depth. */
 283         corresponding_target = stack_target;
 284         while (stack_delta > 0) {
 285             corresponding_target = corresponding_target->prev;
 286             stack_delta--;
 287         }
 288         /* both stacks are now at the same depth.  pop from both until we reach
 289            their common ancestor. */
 290         while (from_ctx->control_stack != corresponding_target) {
 291             PMC *cleanup_sub = NULL;
 292             Stack_Entry_t *e;
 293
 294             if (! from_ctx->control_stack)
 295                 internal_exception(1, "Control stack damaged");
 296             e = stack_entry(interpreter, from_ctx->control_stack, 0);
 297             if (! e)
 298                 internal_exception(1, "Control stack damaged");
 299             if (e->entry_type == STACK_ENTRY_ACTION) {
 300                 /*
 301                  * Disable automatic cleanup routine execution in stack_pop so
 302                  * that we can run the action subroutine manually.  This is
 303                  * because we have to run the sub AFTER it has been popped, lest
 304                  * a new error in the sub cause an infinite loop when invoking
 305                  * an error handler.
 306                  */
 307                 cleanup_sub = UVal_pmc(e->entry);
 308                 e->cleanup = STACK_CLEANUP_NULL;
 309             }
 310             (void)stack_pop(INTERP, &from_ctx->control_stack,
 311                             NULL, NO_STACK_ENTRY_TYPE);
 312             if (cleanup_sub) {
 313                 /* Now it's safe to run. */
 314                 Parrot_runops_fromc_args(interpreter, cleanup_sub,
 315                                          "vI", exception_continuation_p);
 316             }
 317             corresponding_target = corresponding_target->prev;
 318         }
 319         /* run back up the target stack to our destination.  [when we support
 320            dynamic binding (e.g.), we will have to traverse back up, and will
 321            therefore need to keep track on the way down.  -- rgr, 30-Sep-06.] */
 322         to_ctx->control_stack = stack_target;
 323
 324         /* debug print before context is switched */
 325         if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG)) {
 326             PMC *sub = to_ctx->current_sub;
 327
 328             PIO_eprintf(INTERP, "# Back in sub '%Ss'\n",
 329                     Parrot_full_sub_name(INTERP, sub));
 330         }
 331
 332         /*
 333          * set context
 334          */
 335         CONTEXT(INTERP->ctx) = to_ctx;
 336         INTERP->ctx.bp = to_ctx->bp;
 337         INTERP->ctx.bp_ps = to_ctx->bp_ps;
 338         if (ret_continuation_p) {
 339             /* RetContinuation arg passing is handled elsewhere. */
 340             return pc;
 341         }
 342
 343         /* pass args */
 344         if (cc->current_results) {
 345             /* where caller wants result */
 346             to_ctx->current_results = cc->current_results;
 347         }
 348         if (to_ctx->current_results && INTERP->current_args) {
 349             /*
 350              * the register pointer is already switched back
 351              * to the caller, therefore the registers of the
 352              * sub we are returning from aren't marked, if
 353              * inside argument passing a DOD run is triggered
 354              * therefore we have to block DOD
 355              */
 356             Parrot_block_DOD(INTERP);
 357             parrot_pass_args(INTERP,
 358                     from_ctx,
 359                     to_ctx,
 360                     PARROT_OP_set_args_pc);
 361             Parrot_unblock_DOD(INTERP);
 362         }
 363
 364         /* switch segment */
 365         INTERP->current_args = NULL;
 366         if (INTERP->code != cc->seg) {
 367             Parrot_switch_to_cs(INTERP, cc->seg, 1);
 368         }
 369         return pc;
 370     }
 371
 372 /*
 373
 374 =item C<STRING* get_string()>
 375
 376 Experimental: return caller info as a STRING.
 377
 378 =cut
 379
 380 */
 381
 382     STRING* get_string() {
 383         return Parrot_Context_infostr(INTERP, PMC_cont(SELF)->to_ctx);
 384     }
 385
 386 /*
 387
 388 =item C<METHOD PMC* "caller"()>
 389
 390 Experimental: return caller PMC or Undef if none.
 391
 392 =cut
 393
 394 */
 395
 396     METHOD PMC* caller() {
 397         struct Parrot_cont * cc = PMC_cont(SELF);
 398         PMC *caller = cc->to_ctx->current_sub;
 399         if (!caller || !PMC_sub(caller)->seg) {
 400             caller = pmc_new(INTERP, enum_class_Undef);
 401         }
 402         return caller;
 403
 404     }
 405 /*
 406
 407 =item C<METHOD PMC* "continuation"()>
 408
 409 Experimental: return continuation PMC of this Continuation or Undef if none.
 410
 411 =cut
 412
 413 */
 414
 415     METHOD PMC* continuation() {
 416         struct Parrot_cont * cc = PMC_cont(SELF);
 417         PMC *cont = cc->to_ctx->current_cont;
 418         if (cont)
 419             return cont;
 420         return pmc_new(INTERP, enum_class_Undef);
 421     }
 422 }
 423
 424 /*
 425
 426 =back
 427
 428 =head1 HISTORY
 429
 430 Initial revision by sean 2002/08/04.
 431
 432 =cut
 433
 434 */
 435
 436 /*
 437  * Local variables:
 438  * c-indentation-style: bsd
 439  * c-basic-offset: 4
 440  * indent-tabs-mode: nil
 441  * End:
 442  *
 443  * vim: expandtab shiftwidth=4:
 444 */