# New Ticket Created by Jonathan Sillito
# Please include the string: [perl #15846]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=15846 >
This patch supersedes my previous lexical scope patch
<URL: http://rt.perl.org/rt2/Ticket/Display.html?id=15800 >
In this implementation, find_lex and store_lex only operate on the
current pad, and open_lex/close_lex have been renamed to
new_pad/pop_pad.
The implementation is still quite simple (no pad descriptors, no
accessing by index), but is at least a start on what is needed.
The files affected by the patch are:
- core.ops: added implementation the 4 ops.
- dod.c: added interpreter->ctx.pad_stack to the initial first dod pass
(I am not sure how to test if this is correct ...)
- interpreter.c and interpreter.h: added pad_stack to Parrot_Context.
In addition to the patch an updated test and example pasm file are
attached:
- lexicals.t: simple tests for the 4 ops that should to in t/op/
- lexicals.pasm: simple example that should go in examples/assembly/
Again, comments welcome.
--
Jonathan Sillito
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/32009/26690/0ce4d7/lex.patch
-- attachment 2 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/32009/26691/38d4e4/lexicals.t
-- attachment 3 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/32009/26692/dc2ab1/lexicals.pasm
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.187
diff -u -r1.187 core.ops
--- core.ops 26 Jul 2002 19:15:56 -0000 1.187
+++ core.ops 30 Jul 2002 18:42:45 -0000
@@ -3604,6 +3604,23 @@
########################################
+=item B<new_pad>()
+
+Create a new lexical scope pad and push it onto the
+current lexical scope stack.
+
+=item B<pop_pad>()
+
+Pop the current lexical scope pad off the stack
+
+=item B<store_lex>(in PMC, in STR)
+
+Store object $1 as lexical symbol $2
+
+=item B<find_lex>(in PMC, in STR)
+
+Find the lexical variable named $2 and store it in $1
+
=item B<store_global>(in PMC, in STR)
Store global $1 as global symbol $2
@@ -3613,6 +3630,41 @@
Find the global named $2 and store it in $1
=cut
+
+op new_pad() {
+ PMC* hash = pmc_new(interpreter, enum_class_PerlHash);
+ stack_push(interpreter, &interpreter->ctx.pad_stack, hash, STACK_ENTRY_DESTINATION, STACK_CLEANUP_NULL);
+
+ goto NEXT();
+}
+
+op pop_pad() {
+ stack_pop(interpreter, &interpreter->ctx.pad_stack, NULL, STACK_ENTRY_DESTINATION);
+ goto NEXT();
+}
+
+op store_lex(in PMC, in STR) {
+ PMC * hash = NULL;
+ KEY key;
+ Stack_entry_type type = 0;
+ MAKE_KEY(key, $2, enum_key_string, struct_val);
+ hash = (PMC *)stack_peek(interpreter, interpreter->ctx.pad_stack, &type);
+ hash->vtable->set_pmc_keyed(interpreter, hash, NULL, $1, &key);
+ goto NEXT();
+}
+
+op find_lex(out PMC, in STR) {
+ PMC * hash = NULL;
+ KEY key;
+ Stack_entry_type type = 0;
+ MAKE_KEY(key, $2, enum_key_string, struct_val);
+ hash = (PMC *)stack_peek(interpreter, interpreter->ctx.pad_stack, &type);
+ $1 = hash->vtable->get_pmc_keyed(interpreter, hash, &key);
+
+ /* FIXME: should the not found case be an internal_exception ? */
+
+ goto NEXT();
+}
op store_global(in PMC, in STR) {
KEY key;
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/dod.c,v
retrieving revision 1.8
diff -u -r1.8 dod.c
--- dod.c 23 Jul 2002 07:25:02 -0000 1.8
+++ dod.c 30 Jul 2002 18:42:45 -0000
@@ -92,6 +92,23 @@
}
}
+ /* Walk lexical pad stack */
+ cur_stack = interpreter->ctx.pad_stack;
+ while (cur_stack) {
+ if (cur_stack->buffer) {
+ buffer_lives(cur_stack->buffer);
+ entry = (Stack_Entry_t *)(cur_stack->buffer->bufstart);
+ for (i = 0; i < cur_stack->used; i++) {
+ if (STACK_ENTRY_PMC == entry[i].entry_type &&
+ entry[i].entry.pmc_val) {
+ last = mark_used(entry[i].entry.pmc_val, last);
+ }
+ }
+ }
+
+ cur_stack = cur_stack->prev;
+ }
+
/* Finally the general stack */
cur_stack = interpreter->ctx.user_stack;
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.93
diff -u -r1.93 interpreter.c
--- interpreter.c 18 Jul 2002 04:29:39 -0000 1.93
+++ interpreter.c 30 Jul 2002 18:42:45 -0000
@@ -570,6 +570,9 @@
interpreter->DOD_block_level--;
interpreter->GC_block_level--;
+ /* Stack for lexical pads */
+ interpreter->ctx.pad_stack = new_stack(interpreter);
+
/* Need a user stack */
interpreter->ctx.user_stack = new_stack(interpreter);
Index: include/parrot/interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.50
diff -u -r1.50 interpreter.h
--- include/parrot/interpreter.h 18 Jul 2002 04:30:42 -0000 1.50
+++ include/parrot/interpreter.h 30 Jul 2002 18:42:46 -0000
@@ -89,6 +89,7 @@
struct SRegChunk *string_reg_base; /* Base of the string stack */
struct PRegChunk *pmc_reg_base; /* Base of the PMC stack */
+ struct Stack_Chunk *pad_stack; /* Base of the lex pad stack */
struct Stack_Chunk *user_stack; /* Base of the scratch stack */
struct Stack_Chunk *control_stack; /* Base of the flow control stack */
IntStack intstack; /* Base of the regex stack */
@@ -105,7 +106,6 @@
struct Stash *perl_stash; /* Pointer to the global variable
* area */
- struct Scratchpad *cur_pad; /* The current scratchpad */
struct Arenas *arena_base; /* Pointer to this interpreter's
* arena */
void *piodata; /* interpreter's IO system */
#! perl -w
use Parrot::Test tests => 2;
output_is(<<CODE, <<OUTPUT, "simple store and fetch");
new_pad
new P0, .PerlInt
new P1, .PerlInt
set P0, 12
set P1, 7
store_lex P0, "Integer"
find_lex P1, "Integer"
print P1
print "\\n"
end
CODE
12
OUTPUT
output_is(<<CODE, <<OUTPUT, "nested scopes");
new P0, .PerlInt
new P1, .PerlInt
new P2, .PerlInt
new P3, .PerlInt
set P0, 0
set P1, 1
set P2, 2
# outer most lexical scope
new_pad
store_lex P0, "a"
find_lex P3, "a"
print P3
print "\\n"
new_pad
store_lex P1, "a"
new_pad
store_lex P2, "c"
find_lex P3, "c"
print P3
print "\\n"
pop_pad
pop_pad
find_lex P3, "a"
print P3
print "\\n"
end
CODE
0
2
0
OUTPUT
1;
#
# lexicals.pasm
#
# A program to demonstrate lexical scopes.
#
# $Id: $
#
new P0, .PerlInt
new P1, .PerlInt
new P2, .PerlInt
new P3, .PerlInt
set P0, 0
set P1, 1
# outer most lexical scope
new_pad
store_lex P0, "a"
find_lex P3, "a"
print P3 # prints 0
print "\n"
new_pad
store_lex P1, "b"
store_lex P1, "a"
find_lex P3, "a"
print P3 # prints 1
print "\n"
find_lex P3, "b"
print P3 # prints 1
print "\n"
pop_pad
find_lex P3, "a"
print P3 # prints 0
print "\n"
end
