cvsuser 03/06/21 02:22:40
Modified: classes continuation.pmc coroutine.pmc eval.pmc sub.pmc
. core.ops interpreter.c stacks.c sub.c
Log:
22745: Parrot subroutines - 1
Revision Changes Path
1.9 +3 -29 parrot/classes/continuation.pmc
Index: continuation.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/continuation.pmc,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- continuation.pmc 6 Jun 2003 15:14:59 -0000 1.8
+++ continuation.pmc 21 Jun 2003 09:22:36 -0000 1.9
@@ -1,7 +1,7 @@
/* Continuation.pmc
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: continuation.pmc,v 1.8 2003/06/06 15:14:59 leo Exp $
+ * $Id: continuation.pmc,v 1.9 2003/06/21 09:22:36 leo Exp $
* Overview:
* These are the vtable functions for the Continuation base class
* Data Structure and Algorithms:
@@ -14,7 +14,7 @@
#include "parrot/parrot.h"
#include "parrot/method_util.h"
-pmclass Continuation {
+pmclass Continuation extends Sub {
void init () {
struct Parrot_Continuation * cc;
@@ -27,10 +27,6 @@
mem_sys_free(PMC_data(SELF));
}
- void set_integer_native (INTVAL value) {
- ((struct Parrot_Continuation *)PMC_data(SELF))->continuation
- = (opcode_t *)value;
- }
void mark () {
mark_stack(
@@ -63,32 +59,10 @@
stack_mark_cow(retc->ctx.control_stack);
}
- PMC* get_pmc () {
- return SELF;
- }
-
- INTVAL is_same (PMC* value) {
- return SELF == value;
- }
-
- void set_same (PMC* value) {
- PMC_data(SELF) = PMC_data(value);
- }
-
- INTVAL is_equal (PMC* value) {
- return (SELF->vtable == value->vtable
- && memcmp(PMC_data(value), PMC_data(SELF),
- sizeof(struct Parrot_Continuation)) == 0);
- }
-
- INTVAL defined () {
- return ((struct Parrot_Continuation *)PMC_data(SELF))->continuation != NULL;
- }
-
void* invoke (void* next) {
struct Parrot_Continuation * cc
= (struct Parrot_Continuation*)PMC_data(SELF);
restore_context(interpreter, &cc->ctx);
- return cc->continuation; /* interp will jump to this address */
+ return cc->address; /* interp will jump to this address */
}
}
1.16 +13 -56 parrot/classes/coroutine.pmc
Index: coroutine.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/coroutine.pmc,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- coroutine.pmc 6 Jun 2003 15:14:59 -0000 1.15
+++ coroutine.pmc 21 Jun 2003 09:22:36 -0000 1.16
@@ -1,7 +1,7 @@
/* Coroutine.pmc
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: coroutine.pmc,v 1.15 2003/06/06 15:14:59 leo Exp $
+ * $Id: coroutine.pmc,v 1.16 2003/06/21 09:22:36 leo Exp $
* Overview:
* These are the vtable functions for the Coroutine base class
* Data Structure and Algorithms:
@@ -14,11 +14,7 @@
#include "parrot/parrot.h"
#include "parrot/method_util.h"
-pmclass Coroutine {
-
- INTVAL type () {
- return enum_class_Coroutine;
- }
+pmclass Coroutine extends Sub {
STRING* name () {
return whoami;
@@ -30,68 +26,29 @@
}
void destroy () {
- /* XXX stack_destroy for deeper stacks */
- mem_sys_free(((struct Parrot_Coroutine *)PMC_data(SELF))->ctx.user_stack);
- mem_sys_free(((struct Parrot_Coroutine *)PMC_data(SELF))->ctx.control_stack);
+ struct Parrot_Coroutine * co =
+ (struct Parrot_Coroutine *)PMC_data(SELF);
+ stack_destroy(co->ctx.pad_stack);
+ stack_destroy(co->ctx.control_stack);
+ stack_destroy(co->ctx.user_stack);
mem_sys_free(PMC_data(SELF));
}
void mark () {
- struct Parrot_Coroutine * co = (struct Parrot_Coroutine *)PMC_data(SELF);
+ struct Parrot_Coroutine * co =
+ (struct Parrot_Coroutine *)PMC_data(SELF);
mark_stack(INTERP, co->ctx.user_stack);
mark_stack(INTERP, co->ctx.control_stack);
mark_stack(INTERP, co->ctx.pad_stack);
}
- void set_integer (PMC * value) {
- ((struct Parrot_Coroutine*)PMC_data(SELF))->resume
- = (opcode_t*)VTABLE_get_integer(INTERP, value);
- }
-
- void set_integer_native (INTVAL value) {
- ((struct Parrot_Coroutine*)PMC_data(SELF))->resume = (opcode_t*)value;
- }
- PMC* get_pmc () {
- return SELF;
- }
-
- INTVAL is_same (PMC* value) {
- return SELF == value;
- }
-
- INTVAL is_equal (PMC* value) {
- return (SELF->vtable == value->vtable
- && memcmp(PMC_data(value), PMC_data(SELF),
- sizeof(struct Parrot_Coroutine)) == 0);
- }
-
- INTVAL defined () {
- return ((struct Parrot_Coroutine*)PMC_data(SELF))->resume != NULL;
- }
void* invoke (void* next) {
struct Parrot_Coroutine* co = (struct Parrot_Coroutine*)PMC_data(SELF);
- struct Stack_Chunk * tmp_stack = NULL;
- void * dest = co->resume;
- co->resume = (opcode_t *)next;
-
- /*
- * Swap control, user and pad stacks. Data in other parts of the
- * context are not preserved between calls to the coroutine.
- */
-
- tmp_stack = INTERP->ctx.user_stack;
- INTERP->ctx.user_stack = co->ctx.user_stack;
- co->ctx.user_stack = tmp_stack;
-
- tmp_stack = INTERP->ctx.control_stack;
- INTERP->ctx.control_stack = co->ctx.control_stack;
- co->ctx.control_stack = tmp_stack;
-
- tmp_stack = INTERP->ctx.pad_stack;
- INTERP->ctx.pad_stack = co->ctx.pad_stack;
- co->ctx.pad_stack = tmp_stack;
+ void * dest = co->address;
+ co->address = (opcode_t *)next;
+ swap_context(interpreter, &co->ctx);
return dest;
}
1.8 +5 -13 parrot/classes/eval.pmc
Index: eval.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/eval.pmc,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- eval.pmc 6 Jun 2003 15:14:59 -0000 1.7
+++ eval.pmc 21 Jun 2003 09:22:36 -0000 1.8
@@ -1,7 +1,7 @@
/* Eval.pmc
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: eval.pmc,v 1.7 2003/06/06 15:14:59 leo Exp $
+ * $Id: eval.pmc,v 1.8 2003/06/21 09:22:36 leo Exp $
* Overview:
* These are the vtable functions for evaluating a code segment
* Data Structure and Algorithms:
@@ -23,17 +23,9 @@
}
void* invoke (void* next) {
- PMC * pad = ((struct Parrot_Sub *)PMC_data(SELF))->lex_pad;
struct PackFile_ByteCode *old_cs;
struct PackFile_ByteCode *eval_cs = (struct PackFile_ByteCode *)
- ((struct Parrot_Sub *)PMC_data(SELF))->init;
-
- if (pad) {
- /* put the correct pad in place
- * XXX leo: do we need this? */
- stack_push(INTERP, &INTERP->ctx.pad_stack, pad,
- STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
- }
+ SUPER(next); /* invoke on Sub returns the address */
/* return address that the interpreter should jump to */
stack_push(INTERP, &(INTERP->ctx.control_stack), next,
@@ -49,9 +41,9 @@
PIO_eprintf(interpreter, "*** back from %s\n",
eval_cs->base.name);
}
- if (pad)
- stack_pop(interpreter, &interpreter->ctx.pad_stack,
- NULL, STACK_ENTRY_PMC);
+ /* restore ctx */
+ interpreter->ctx.pad_stack =
+ ((struct Parrot_Sub*) PMC_data(SELF))->ctx.pad_stack;
/* if code jumped to different code segment, go out of runloop
* which then actually will switch segments */
if (interpreter->resume_flag & 2)
1.16 +34 -24 parrot/classes/sub.pmc
Index: sub.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sub.pmc,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- sub.pmc 18 Jun 2003 12:28:54 -0000 1.15
+++ sub.pmc 21 Jun 2003 09:22:36 -0000 1.16
@@ -1,7 +1,7 @@
/* Sub.pmc
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: sub.pmc,v 1.15 2003/06/18 12:28:54 dan Exp $
+ * $Id: sub.pmc,v 1.16 2003/06/21 09:22:36 leo Exp $
* Overview:
* These are the vtable functions for the Sub (subroutine) base class
* Data Structure and Algorithms:
@@ -12,6 +12,7 @@
*/
#include "parrot/parrot.h"
+#include "parrot/method_util.h"
pmclass Sub {
@@ -20,48 +21,57 @@
}
void init () {
- INTVAL address = 0; /* XXX this was originally passed as a
- * parameter, but that's not valid. So
- * this is totally broken now. */
- PMC_data(SELF) = new_sub(INTERP, (opcode_t*)address);
+ PMC_data(SELF) = new_sub(INTERP, (opcode_t*)0);
PObj_custom_mark_destroy_SETALL(SELF);
}
void mark () {
- PMC * pad = ((struct Parrot_Sub *)PMC_data(SELF))->lex_pad;
- if (pad) {
- pobject_lives(INTERP, (PObj *)pad);
- }
+ struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_data(SELF);
+ mark_stack(INTERP, sub->ctx.pad_stack);
}
void destroy () {
- mem_sys_free(PMC_data(SELF));
+ struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_data(SELF);
+ stack_destroy(sub->ctx.pad_stack);
+ mem_sys_free(sub);
}
void set_integer (PMC * value) {
- ((struct Parrot_Sub*)PMC_data(SELF))->init =
(opcode_t*)VTABLE_get_integer(INTERP, value);
+ ((struct Parrot_Sub*)PMC_data(SELF))->address =
+ (opcode_t*)VTABLE_get_integer(INTERP, value);
}
void set_integer_native (INTVAL value) {
- ((struct Parrot_Sub*)PMC_data(SELF))->init = (opcode_t*)value;
+ ((struct Parrot_Sub*)PMC_data(SELF))->address = (opcode_t*)value;
}
- void* invoke (void* next) {
- PMC * pad = ((struct Parrot_Sub *)PMC_data(SELF))->lex_pad;
-
- if (pad) {
- /* put the correct pad in place */
- stack_push(INTERP, &INTERP->ctx.pad_stack, pad,
- STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
+ INTVAL defined () {
+ return ((struct Parrot_Sub*)PMC_data(SELF))->address != NULL;
}
- return ((struct Parrot_Sub*)PMC_data(SELF))->init;
+ void* invoke (void* next) {
+ struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_data(SELF);
+ INTERP->ctx.pad_stack = sub->ctx.pad_stack;
+
+ return sub->address;
}
void clone (PMC *ret) {
+ struct Parrot_Sub * sub;
PObj_custom_mark_destroy_SETALL(ret);
- PMC_data(ret) = mem_sys_allocate(sizeof(struct Parrot_Sub));
- memcpy(PMC_data(ret), PMC_data(SELF), sizeof(struct Parrot_Sub));
+ sub = PMC_data(ret) = mem_sys_allocate(sizeof(struct Parrot_Sub));
+ memcpy(sub, PMC_data(SELF), sizeof(struct Parrot_Sub));
+ stack_mark_cow(sub->ctx.pad_stack);
+ }
+
+ void set_same (PMC* value) {
+ PMC_data(SELF) = PMC_data(value);
+ }
+
+ INTVAL is_equal (PMC* value) {
+ return (SELF->vtable == value->vtable
+ && memcmp(PMC_data(value), PMC_data(SELF),
+ sizeof(struct Parrot_Sub)) == 0);
}
}
1.288 +4 -11 parrot/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.287
retrieving revision 1.288
diff -u -w -r1.287 -r1.288
--- core.ops 19 Jun 2003 13:00:20 -0000 1.287
+++ core.ops 21 Jun 2003 09:22:39 -0000 1.288
@@ -1188,23 +1188,18 @@
=cut
inline op newsub(out PMC, in INT, inconst INT) {
- opcode_t *addr_sub;
-
if ($2 <= 0 || $2 >= enum_class_max) {
internal_exception(1, "Illegal PMC enum (%d) in newsub\n", (int)$2);
abort(); /* Deserve to lose */
}
$1 = pmc_new_noinit(interpreter, $2);
$1->vtable->init(interpreter, $1);
- addr_sub = CUR_OPCODE + $3 - REL_PC;
- VTABLE_set_integer_native(interpreter, $1, PTR2OPCODE_T(addr_sub));
+ VTABLE_set_integer_native(interpreter, $1,
+ PTR2OPCODE_T(CUR_OPCODE + $3 - REL_PC));
goto NEXT();
}
inline op newsub(in INT, in INT, inconst INT, inconst INT) {
- opcode_t *addr_sub;
- opcode_t *addr_ret;
-
if ($1 <= 0 || $1 >= enum_class_max) {
internal_exception(1, "Illegal PMC enum (%d) in newsub\n", (int)$1);
abort(); /* Deserve to lose */
@@ -1215,14 +1210,12 @@
}
interpreter->pmc_reg.registers[0] = pmc_new_noinit(interpreter, $1);
VTABLE_init(interpreter, interpreter->pmc_reg.registers[0]);
- addr_sub = CUR_OPCODE + $3 - REL_PC;
VTABLE_set_integer_native(interpreter, interpreter->pmc_reg.registers[0],
- PTR2OPCODE_T(addr_sub));
+ PTR2OPCODE_T(CUR_OPCODE + $3 - REL_PC));
interpreter->pmc_reg.registers[1] = pmc_new_noinit(interpreter, $2);
VTABLE_init(interpreter, interpreter->pmc_reg.registers[1]);
- addr_ret = CUR_OPCODE + $4 - REL_PC;
VTABLE_set_integer_native(interpreter, interpreter->pmc_reg.registers[1],
- PTR2OPCODE_T(addr_ret));
+ PTR2OPCODE_T(CUR_OPCODE + $4 - REL_PC));
goto NEXT();
}
1.160 +4 -18 parrot/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.159
retrieving revision 1.160
diff -u -w -r1.159 -r1.160
--- interpreter.c 18 Jun 2003 18:56:41 -0000 1.159
+++ interpreter.c 21 Jun 2003 09:22:40 -0000 1.160
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: interpreter.c,v 1.159 2003/06/18 18:56:41 dan Exp $
+ * $Id: interpreter.c,v 1.160 2003/06/21 09:22:40 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -669,23 +669,9 @@
}
}
- /* XXX move this to stacks.c */
- {
- Stack_Chunk_t *chunks[3];
- chunks[0] = interpreter->ctx.pad_stack;
- chunks[1] = interpreter->ctx.user_stack;
- chunks[2] = interpreter->ctx.control_stack;
- for (i = 0; i< 3; i++) {
- Stack_Chunk_t *top = chunks[i];
- while (top->next)
- top = top->next;
- while(top) {
- Stack_Chunk_t *next = top->prev;
- mem_sys_free(top);
- top = next;
- }
- }
- }
+ stack_destroy(interpreter->ctx.pad_stack);
+ stack_destroy(interpreter->ctx.user_stack);
+ stack_destroy(interpreter->ctx.control_stack);
/* intstack */
intstack_free(interpreter, interpreter->ctx.intstack);
1.54 +13 -1 parrot/stacks.c
Index: stacks.c
===================================================================
RCS file: /cvs/public/parrot/stacks.c,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -w -r1.53 -r1.54
--- stacks.c 13 Jun 2003 19:48:47 -0000 1.53
+++ stacks.c 21 Jun 2003 09:22:40 -0000 1.54
@@ -1,7 +1,7 @@
/* stacks.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: stacks.c,v 1.53 2003/06/13 19:48:47 dan Exp $
+ * $Id: stacks.c,v 1.54 2003/06/21 09:22:40 leo Exp $
* Overview:
* Stack handling routines for Parrot
* Data Structure and Algorithms:
@@ -44,6 +44,18 @@
entry[i].flags = NO_STACK_ENTRY_FLAGS;
#endif
return stack;
+}
+
+void
+stack_destroy(Stack_Chunk_t * top)
+{
+ while (top->next)
+ top = top->next;
+ while(top) {
+ Stack_Chunk_t *next = top->prev;
+ mem_sys_free(top);
+ top = next;
+ }
}
void
1.21 +36 -7 parrot/sub.c
Index: sub.c
===================================================================
RCS file: /cvs/public/parrot/sub.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -w -r1.20 -r1.21
--- sub.c 18 Jun 2003 12:28:50 -0000 1.20
+++ sub.c 21 Jun 2003 09:22:40 -0000 1.21
@@ -1,7 +1,7 @@
/* sub.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: sub.c,v 1.20 2003/06/18 12:28:50 dan Exp $
+ * $Id: sub.c,v 1.21 2003/06/21 09:22:40 leo Exp $
* Overview:
* Sub-routines, co-routines and other fun stuff...
* Data Structure and Algorithms:
@@ -24,6 +24,29 @@
}
void
+swap_context(struct Parrot_Interp *interp, struct Parrot_Context *ctx)
+{
+ struct Stack_Chunk * tmp_stack = NULL;
+ /*
+ * Swap control, user and pad stacks. Data in other parts of the
+ * context are not preserved between calls to the coroutine.
+ */
+
+ tmp_stack = interp->ctx.user_stack;
+ interp->ctx.user_stack = ctx->user_stack;
+ ctx->user_stack = tmp_stack;
+
+ tmp_stack = interp->ctx.control_stack;
+ interp->ctx.control_stack = ctx->control_stack;
+ ctx->control_stack = tmp_stack;
+
+ tmp_stack = interp->ctx.pad_stack;
+ interp->ctx.pad_stack = ctx->pad_stack;
+ ctx->pad_stack = tmp_stack;
+
+}
+
+void
restore_context(struct Parrot_Interp *interp, struct Parrot_Context *ctx)
{
memcpy(&interp->ctx, ctx, sizeof(*ctx));
@@ -34,8 +57,14 @@
{
/* Using system memory until I figure out GC issues */
struct Parrot_Sub *newsub = mem_sys_allocate(sizeof(struct Parrot_Sub));
- newsub->init = address;
- newsub->lex_pad = scratchpad_get_current(interp);
+ PMC * pad = scratchpad_get_current(interp);
+ newsub->address = address;
+ newsub->ctx.pad_stack = new_stack(interp);
+ if (pad) {
+ /* put the correct pad in place */
+ stack_push(interp, &newsub->ctx.pad_stack, pad,
+ STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
+ }
return newsub;
}
@@ -46,7 +75,7 @@
PMC * pad = NULL;
struct Parrot_Coroutine *newco =
mem_sys_allocate(sizeof(struct Parrot_Coroutine));
- newco->resume = NULL;
+ newco->address = NULL;
newco->ctx.user_stack = new_stack(interp);
newco->ctx.control_stack = new_stack(interp);
newco->ctx.pad_stack = new_stack(interp);
@@ -65,7 +94,7 @@
{
struct Parrot_Continuation *cc =
mem_sys_allocate(sizeof(struct Parrot_Continuation));
- cc->continuation = address;
+ cc->address = address;
save_context(interp, &cc->ctx);
return cc;
}
@@ -75,7 +104,7 @@
new_continuation_pmc(struct Parrot_Interp * interp, opcode_t * address)
{
PMC* continuation = pmc_new(interp, enum_class_Continuation);
- ((struct Parrot_Continuation*)PMC_data(continuation))->continuation = address;
+ ((struct Parrot_Continuation*)PMC_data(continuation))->address = address;
return continuation;
}
