Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 0ae5d55426
Fetching contributors…

Cannot retrieve contributors at this time

235 lines (184 sloc) 6.135 kb
/*
Copyright (C) 2001-2003, The Perl Foundation.
$Id$
=head1 NAME
src/pmc/closure.pmc - Closure PMC
=head1 DESCRIPTION
This class implements a closure, i.e. a subroutine which take a context
structure.
=head2 Methods
=over 4
=cut
*/
#include "parrot/parrot.h"
pmclass Closure extends Sub need_ext {
/*
=item C<void init()>
Initializes the closure.
=cut
*/
void init() {
PMC_struct_val(SELF) = new_closure(INTERP);
PMC_pmc_val(SELF) = NULL;
PObj_custom_mark_destroy_SETALL(SELF);
#if 0
if (Interp_flags_TEST(INTERP, PARROT_DEBUG_FLAG))
printf("Address of base segment is %p\n",
(PMC_sub(SELF))->seg->base.pf->base.data);
#endif
}
/*
=item C<void mark()>
Marks the closure as live.
=cut
*/
void mark() {
struct Parrot_sub * sub = PMC_sub(SELF);
SUPER();
if (sub->outer_sub)
pobject_lives(INTERP, (PObj*)sub->outer_sub);
if (sub->outer_ctx)
mark_context(INTERP, sub->outer_ctx);
}
/*
=item C<void set_pointer(void *value)>
Sets the address to the closure entry.
=item C<void* invoke(void* next)>
Invokes the closure.
=cut
*/
void set_pointer(void* value) {
struct Parrot_sub * sub = PMC_sub(SELF);
opcode_t *addr = value;
sub->start_offs = addr - sub->seg->base.data;
}
opcode_t* invoke(void* next) {
struct Parrot_sub * sub = PMC_sub(SELF);
PMC *cont, *outer_sub;
next = SUPER(next);
outer_sub = sub->outer_sub;
if (sub->outer_ctx) {
/* during newclosure, outer's ctx was stored in
* sub->outer_ctx
*/
sub->ctx->outer_ctx = sub->outer_ctx;
}
else if ((PObj_get_FLAGS(outer_sub) & SUB_FLAG_IS_OUTER) &&
PMC_sub(outer_sub)->ctx) {
/* the sub was invoked earlier - it still has the context
* due to the SUB_FLAG_IS_OUTER flag
*/
sub->outer_ctx = sub->ctx->outer_ctx = PMC_sub(outer_sub)->ctx;
}
else {
/* closure is just invoked - located :outer's ctx */
parrot_context_t *caller = sub->ctx->caller_ctx;
while (caller) {
if (caller->current_sub == outer_sub) {
cont = caller->current_cont;
cont->vtable =
interp->vtables[enum_class_Continuation];
sub->outer_ctx = sub->ctx->outer_ctx = caller;
caller->ref_count++;
return next;
}
caller = caller->caller_ctx;
}
if (!caller) {
/* outer has never been invoked, we fake a subroutine call
* which builds the LexPad and return immediately
* this will usually just lead to a Null PMC access
* exception
*/
INTERP->current_cont = NEED_CONTINUATION;
(void)VTABLE_invoke(INTERP, sub->outer_sub, next);
caller = CONTEXT(INTERP->ctx);
cont = caller->current_cont;
cont->vtable = interp->vtables[enum_class_Continuation];
sub->outer_ctx = sub->ctx->outer_ctx = caller;
caller->ref_count++;
(void)VTABLE_invoke(INTERP, cont, next);
}
}
return next;
}
void thawfinish(visit_info *info) {
struct Parrot_sub * sub = PMC_sub(SELF);
PMC *outer;
opcode_t i, ci;
struct PackFile_FixupTable *ft;
struct PackFile_ConstTable *ct;
/*
* XXX TODO
*
* A Sub PMC is frozen/thawed per item, OTOH it can refer to other
* subs via the outer_sub (:outer) syntax. This outer though, is created
* independently when running from .pbc, which breaks referential
* integrity.
*
* The only fix (except this ugly and slow code) is to freeze/thaw
* a code segment as one structure, which will take care of all
* refs and self-refs.
*
* TODO - intermediate step:
*
* Investigate if we can:
* - freeze array of subs (instead of the useless fixup seg)
* - do we need the Sub constant in the const seg as PMC constant?
*/
if (PMC_IS_NULL(sub->outer_sub))
return;
ft = sub->seg->fixups;
ct = sub->seg->const_table;
for (i = 0; i < ft->fixup_count; i++) {
switch (ft->fixups[i]->type) {
case enum_fixup_sub:
ci = ft->fixups[i]->offset;
if (ci < 0 || ci >= ct->const_count - 1)
return; /* not yet thawed */
if (ct->constants[ci]->type != PFC_PMC)
return; /* same */
outer = ct->constants[ci]->u.key;
if (PMC_IS_NULL(outer))
continue;
if (0 == string_equal(INTERP, PMC_sub(outer)->name,
PMC_sub(sub->outer_sub)->name)) {
sub->outer_sub = outer;
break;
}
}
}
}
/*
=item C<void destroy()>
Destroys the closure. This is necessary in order to reclaim the context.
=cut
*/
void destroy() {
struct Parrot_sub * sub = PMC_sub(SELF);
#if CTX_LEAK_DEBUG
if (Interp_debug_TEST(INTERP, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
fprintf(stderr, "[destroy closure %p, context %p, refs=%d]\n",
(void *)SELF, (void *)sub->outer_ctx,
(sub->outer_ctx ? sub->outer_ctx->ref_count : 0));
}
#endif
if (sub->outer_ctx) {
Parrot_free_context(interp, sub->outer_ctx, 0);
sub->outer_ctx = NULL;
}
SUPER();
}
}
/*
=back
=head1 HISTORY
Initial version by Leo.
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4:
*/
Jump to Line
Something went wrong with that request. Please try again.