The good news is that the attached patch makes this work. The bad
news is that it also breaks PGE, albeit in a small way. Six of the
"<after>" tests (mostly, but not exclusively, involving "<!after>") in
t/compilers/pge/p6rules/builtins.t seem to go into an infinite loop. I
have been unable to figure this out, so I'm hoping it will be easy for
someone who understands PGE. (Maybe there's something in PGE that
assumes that returning from a sub restores the state of the user stack?)
When (and if) that happens, we can decide whether this patch is worth
doing. TIA,
-- Bob Rogers
http://rgrjr.dyndns.org/
Index: src/ops/stack.ops
===================================================================
--- src/ops/stack.ops (revision 11707)
+++ src/ops/stack.ops (working copy)
@@ -78,7 +78,7 @@
op entrytype(out INT, in INT) :base_core {
Stack_Entry_t *entry;
- entry = stack_entry(interpreter, CONTEXT(interpreter->ctx)->user_stack, $2);
+ entry = stack_entry(interpreter, interpreter->user_stack, $2);
if (!entry) {
internal_exception(99, "Stack Depth wrong");
}
@@ -95,7 +95,7 @@
=cut
inline op depth(out INT) :base_core {
- $1 = stack_height(interpreter, CONTEXT(interpreter->ctx)->user_stack);
+ $1 = stack_height(interpreter, interpreter->user_stack);
goto NEXT();
}
@@ -118,7 +118,7 @@
op lookback(out INT, in INT) :base_core {
Stack_Entry_t *entry =
- stack_entry(interpreter, CONTEXT(interpreter->ctx)->user_stack, $2);
+ stack_entry(interpreter, interpreter->user_stack, $2);
if (!entry)
internal_exception(99, "Stack depth wrong");
if (entry->entry_type != STACK_ENTRY_INT) {
@@ -131,7 +131,7 @@
op lookback(out STR, in INT) :base_core {
Stack_Entry_t *entry =
- stack_entry(interpreter, CONTEXT(interpreter->ctx)->user_stack, $2);
+ stack_entry(interpreter, interpreter->user_stack, $2);
if (!entry)
internal_exception(99, "Stack depth wrong");
if (entry->entry_type != STACK_ENTRY_STRING) {
@@ -144,7 +144,7 @@
op lookback(out NUM, in INT) :base_core {
Stack_Entry_t *entry =
- stack_entry(interpreter, CONTEXT(interpreter->ctx)->user_stack, $2);
+ stack_entry(interpreter, interpreter->user_stack, $2);
if (!entry)
internal_exception(99, "Stack depth wrong");
if (entry->entry_type != STACK_ENTRY_FLOAT) {
@@ -157,7 +157,7 @@
op lookback(out PMC, in INT) :base_core {
Stack_Entry_t *entry =
- stack_entry(interpreter, CONTEXT(interpreter->ctx)->user_stack, $2);
+ stack_entry(interpreter, interpreter->user_stack, $2);
if (!entry)
internal_exception(99, "Stack depth wrong");
if (entry->entry_type != STACK_ENTRY_PMC) {
@@ -184,22 +184,22 @@
inline op save(in INT) :base_core {
INTVAL i = $1;
- stack_push(interpreter, &CONTEXT(interpreter->ctx)->user_stack, &i,
STACK_ENTRY_INT, STACK_CLEANUP_NULL);
+ stack_push(interpreter, &interpreter->user_stack, &i, STACK_ENTRY_INT,
STACK_CLEANUP_NULL);
goto NEXT();
}
inline op save(in NUM) :base_core {
- stack_push(interpreter, &CONTEXT(interpreter->ctx)->user_stack, &($1),
STACK_ENTRY_FLOAT, STACK_CLEANUP_NULL);
+ stack_push(interpreter, &interpreter->user_stack, &($1), STACK_ENTRY_FLOAT,
STACK_CLEANUP_NULL);
goto NEXT();
}
inline op save(in PMC) :base_core {
- stack_push(interpreter, &CONTEXT(interpreter->ctx)->user_stack, $1,
STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
+ stack_push(interpreter, &interpreter->user_stack, $1, STACK_ENTRY_PMC,
STACK_CLEANUP_NULL);
goto NEXT();
}
inline op save(in STR) :base_core {
- stack_push(interpreter, &CONTEXT(interpreter->ctx)->user_stack, $1,
STACK_ENTRY_STRING, STACK_CLEANUP_NULL);
+ stack_push(interpreter, &interpreter->user_stack, $1, STACK_ENTRY_STRING,
STACK_CLEANUP_NULL);
goto NEXT();
}
@@ -212,7 +212,7 @@
=cut
inline op savec(in STR) :base_core {
- stack_push(interpreter, &CONTEXT(interpreter->ctx)->user_stack,
string_copy(interpreter, $1), STACK_ENTRY_STRING, STACK_CLEANUP_NULL);
+ stack_push(interpreter, &interpreter->user_stack, string_copy(interpreter,
$1), STACK_ENTRY_STRING, STACK_CLEANUP_NULL);
goto NEXT();
}
@@ -231,25 +231,25 @@
=cut
inline op restore(out INT) :base_core {
- (void)stack_pop(interpreter, &CONTEXT(interpreter->ctx)->user_stack, &($1),
+ (void)stack_pop(interpreter, &interpreter->user_stack, &($1),
STACK_ENTRY_INT);
goto NEXT();
}
inline op restore(out NUM) :base_core {
- (void)stack_pop(interpreter, &CONTEXT(interpreter->ctx)->user_stack, &($1),
+ (void)stack_pop(interpreter, &interpreter->user_stack, &($1),
STACK_ENTRY_FLOAT);
goto NEXT();
}
inline op restore(out PMC) :base_core {
- (void)stack_pop(interpreter, &CONTEXT(interpreter->ctx)->user_stack, &($1),
+ (void)stack_pop(interpreter, &interpreter->user_stack, &($1),
STACK_ENTRY_PMC);
goto NEXT();
}
inline op restore(out STR) :base_core {
- (void)stack_pop(interpreter, &CONTEXT(interpreter->ctx)->user_stack, &($1),
+ (void)stack_pop(interpreter, &interpreter->user_stack, &($1),
STACK_ENTRY_STRING);
goto NEXT();
}
@@ -269,7 +269,7 @@
=cut
inline op rotate_up(in INT) :base_core {
- rotate_entries(interpreter, &CONTEXT(interpreter->ctx)->user_stack, $1);
+ rotate_entries(interpreter, &interpreter->user_stack, $1);
goto NEXT();
}
Index: src/register.c
===================================================================
--- src/register.c (revision 11707)
+++ src/register.c (working copy)
@@ -233,7 +233,6 @@
/* some items should better be COW copied */
ctx->constants = old->constants;
ctx->reg_stack = old->reg_stack; /* XXX move into interpreter? */
- ctx->user_stack = old->user_stack; /* XXX move into interpreter? */
ctx->control_stack = old->control_stack;
ctx->warns = old->warns;
ctx->errors = old->errors;
Index: src/debug.c
===================================================================
--- src/debug.c (revision 11707)
+++ src/debug.c (working copy)
@@ -2098,7 +2098,7 @@
PDB_print_user_stack(Interp *interpreter, const char *command)
{
long depth = 0;
- Stack_Chunk_t *chunk = CONTEXT(interpreter->ctx)->user_stack;
+ Stack_Chunk_t *chunk = interpreter->user_stack;
Stack_Entry_t *entry;
if (*command) {
Index: src/dod.c
===================================================================
--- src/dod.c (revision 11707)
+++ src/dod.c (working copy)
@@ -296,6 +296,9 @@
ctx = CONTEXT(interpreter->ctx);
mark_context(interpreter, ctx);
+ /* mark the user stack. */
+ mark_stack(interpreter, interpreter->user_stack);
+
/*
* mark vtable->data
*
Index: src/inter_create.c
===================================================================
--- src/inter_create.c (revision 11707)
+++ src/inter_create.c (working copy)
@@ -165,6 +165,9 @@
SET_NULL(interpreter->HLL_info);
Parrot_init(interpreter);
+ /* Need a user stack */
+ interpreter->user_stack = new_stack(interpreter, "User");
+
/* context data */
/* Initialize interpreter's flags */
PARROT_WARNINGS_off(interpreter, PARROT_WARNINGS_ALL_FLAG);
@@ -185,10 +188,7 @@
/* Set up the initial register chunks */
setup_register_stacks(interpreter);
- /* Need a user stack */
- CONTEXT(interpreter->ctx)->user_stack = new_stack(interpreter, "User");
-
- /* And a control stack */
+ /* Need a control stack */
CONTEXT(interpreter->ctx)->control_stack = new_stack(interpreter,
"Control");
/* clear context introspection vars */
@@ -392,7 +392,7 @@
/* deinit op_lib */
(void) PARROT_CORE_OPLIB_INIT(0);
- stack_destroy(CONTEXT(interpreter->ctx)->user_stack);
+ stack_destroy(interpreter->user_stack);
stack_destroy(CONTEXT(interpreter->ctx)->control_stack);
destroy_context(interpreter);
Index: src/stacks.c
===================================================================
--- src/stacks.c (revision 11707)
+++ src/stacks.c (working copy)
@@ -150,7 +150,7 @@
/* For negative depths, look from the bottom of the stack up. */
if (depth < 0) {
- depth = stack_height(interpreter,
CONTEXT(interpreter->ctx)->user_stack) + depth;
+ depth = stack_height(interpreter, interpreter->user_stack) + depth;
if (depth < 0)
return NULL;
offset = (size_t)depth;
Index: src/sub.c
===================================================================
--- src/sub.c (revision 11707)
+++ src/sub.c (working copy)
@@ -38,7 +38,6 @@
PObj *obj;
int i;
- mark_stack(interpreter, ctx->user_stack);
mark_stack(interpreter, ctx->control_stack);
mark_register_stack(interpreter, ctx->reg_stack);
obj = (PObj*)ctx->current_sub;
Index: include/parrot/interpreter.h
===================================================================
--- include/parrot/interpreter.h (revision 11707)
+++ include/parrot/interpreter.h (working copy)
@@ -187,7 +187,6 @@
int ref_count; /* how often refered to */
struct Stack_Chunk *reg_stack; /* register stack */
- struct Stack_Chunk *user_stack; /* Base of the scratch stack */
struct Stack_Chunk *control_stack; /* Base of the flow control stack */
PMC *lex_pad; /* LexPad PMC */
struct Parrot_Context *outer_ctx; /* outer context, if a closure */
@@ -379,6 +378,7 @@
PMC *current_cont; /* the return continuation PMC */
PMC *current_object; /* current object if a method
call */
STRING *current_method; /* name of method */
+ struct Stack_Chunk *user_stack; /* Base of the scratch stack */
};
/* typedef struct parrot_interp_t Interp; done in parrot.h so that
Index: t/op/stacks.t
===================================================================
--- t/op/stacks.t (revision 11707)
+++ t/op/stacks.t (working copy)
@@ -605,9 +605,67 @@
Stack 'Control' too deep
OUTPUT
}
+
+pir_output_is(<<'CODE', <<'OUTPUT', "save/restore across contexts [1]");
+.sub main :main
+ $I0 = 11
+ save $I0
+ test_1()
+ restore $I0
+ print $I0
+ print "\n"
+.end
+.sub test_1
+ save 22
+.end
+CODE
+22
+OUTPUT
+
+pir_output_is(<<'CODE', <<'OUTPUT', "save/restore across contexts [2]");
+.sub main :main
+ $I0 = 11
+ save $I0
+ inc $I0
+ save $I0
+ test_1()
+ restore $I0
+ print $I0
+ print "\n"
+.end
+.sub test_1
+ restore $I22
+.end
+CODE
+11
+OUTPUT
+
+pir_output_is(<<'CODE', <<'OUTPUT', "stack memory use");
+## This does lots of pushes and pops, but should run in constant memory.
+.sub main :main
+ $I0 = 1000000
+ $I1 = 0
+push_loop:
+ inc $I1
+ if $I1 >= $I0 goto ok
+ save $I1
+ save $I1
+ save $I1
+ restore $I2
+ restore $I2
+ restore $I2
+ if $I1 == $I2 goto push_loop
+ print "not "
+ok:
+ print "ok\n"
+.end
+CODE
+ok
+OUTPUT
+
##############################
## remember to change the number of tests :-)
-BEGIN { plan tests => 24; }
+BEGIN { plan tests => 27; }
