cvsuser 04/09/28 07:19:47
Modified: classes coroutine.pmc
include/parrot sub.h
src packfile.c
Log:
fix coroutine related bugs
* bytecode segment switching for yield was broken
* Sub PMC names got collected - mark names
Revision Changes Path
1.42 +41 -30 parrot/classes/coroutine.pmc
Index: coroutine.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/coroutine.pmc,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -w -r1.41 -r1.42
--- coroutine.pmc 23 Sep 2004 12:48:25 -0000 1.41
+++ coroutine.pmc 28 Sep 2004 14:19:45 -0000 1.42
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: coroutine.pmc,v 1.41 2004/09/23 12:48:25 leo Exp $
+$Id: coroutine.pmc,v 1.42 2004/09/28 14:19:45 leo Exp $
=head1 NAME
@@ -102,6 +102,7 @@
void* invoke (void* next) {
struct Parrot_coro * sub = PMC_coro(SELF);
+ struct PackFile_ByteCode *wanted_seg;
void * dest = sub->address;
int argcP = REG_INT(3);
/* python calls the coroutine initially during
@@ -118,13 +119,23 @@
scratchpad_store_by_index(INTERP, pad, -1, i, REG_PMC(5+i));
}
REG_PMC(5) = ret;
+ cor->caller_seg = interpreter->code->cur_cs;
return next;
}
sub->address = next;
+ /* if calling the Coro we need the segment of the Coro */
+ if (!(PObj_get_FLAGS(SELF) & PObj_private0_FLAG)) {
+ wanted_seg = sub->seg;
+ /* remember segment of caller */
+ sub->caller_seg = interpreter->code->cur_cs;
+ }
+ else {
+ wanted_seg = sub->caller_seg;
+ }
swap_context(interpreter, SELF);
- if (interpreter->code->cur_cs != sub->seg) {
- Parrot_switch_to_cs(interpreter, sub->seg, 1);
+ if (interpreter->code->cur_cs != wanted_seg) {
+ Parrot_switch_to_cs(interpreter, wanted_seg, 1);
}
return dest;
}
1.34 +2 -1 parrot/include/parrot/sub.h
Index: sub.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/sub.h,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -w -r1.33 -r1.34
--- sub.h 23 Sep 2004 12:48:27 -0000 1.33
+++ sub.h 28 Sep 2004 14:19:46 -0000 1.34
@@ -1,7 +1,7 @@
/* sub.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: sub.h,v 1.33 2004/09/23 12:48:27 leo Exp $
+ * $Id: sub.h,v 1.34 2004/09/28 14:19:46 leo Exp $
* Overview:
* Data Structure and Algorithms:
* Subroutine, coroutine, closure and continuation structures
@@ -49,6 +49,7 @@
struct Parrot_Context ctx; /* XXX 2 continuations */
struct Stack_Chunk *co_control_base;
struct Stack_Chunk *co_control_stack; /* control stack top of the cor.*/
+ struct PackFile_ByteCode *caller_seg; /* bytecode segment */
} * parrot_coro_t;
#define PMC_coro(pmc) LVALUE_CAST(parrot_coro_t, PMC_pmc_val(pmc))
1.175 +2 -1 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.174
retrieving revision 1.175
diff -u -w -r1.174 -r1.175
--- packfile.c 23 Sep 2004 12:48:29 -0000 1.174
+++ packfile.c 28 Sep 2004 14:19:47 -0000 1.175
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packfile.c,v 1.174 2004/09/23 12:48:29 leo Exp $
+$Id: packfile.c,v 1.175 2004/09/28 14:19:47 leo Exp $
=head1 NAME
@@ -355,6 +355,7 @@
ci = ft->fixups[i]->offset;
sub_pmc = ct->constants[ci]->u.key;
pobject_lives(interpreter, (PObj *)sub_pmc);
+ pobject_lives(interpreter, (PObj *)PMC_sub(sub_pmc)->name);
break;
}
}
