On Mon, 2002-07-29 at 17:12, Simon Glover wrote:
> I think you forgot to attach the patch...
oops, now the files are attached ...
- patch: lex.patch
- test file: lexicals.t
- example file: lexicals.pasm
On Tue, 2002-07-30 at 02:14, Stephen Rawls wrote:
> --- Jonathan Sillito
> > close_lex # end of nested lexical scope
> >
> > find_lex P3, "a"
> > print P3 # prints 12
> > print "\n"
> > end
> >
>
> That's a typo, right? It should print the first value
> of "a" (10). Just making sure I'm not crazy ...
Hey, thanks for reading this over. It is not a typo, but it may be
incorrect. My code does overwrite previous lexicals in enclosing scopes
(i.e. lexicals in pads lower on the stack), but maybe I have the
semantics of the store_lex op wrong? The following example shows what I
had in mind:
my $x = 13;
sub foo
{
$x = 12;
}
foo();
print $x; # prints 12
The alternative (what you have in mind I guess) is:
my $x = 13;
sub foo
{
my $x = 12; # notice the my
}
foo();
print $x; # prints 13
So I guess I see your point. Let me know if I should change the
implementation (it would be a quick change). Also note that there is
currently no support for accessing lexicals by index or for creating
pads from descriptors.
Thanks for any comments.
--
Jonathan Sillito
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 29 Jul 2002 23:03:24 -0000
@@ -3604,6 +3604,24 @@
########################################
+=item B<open_lex>()
+
+Start a new lexical scope
+
+=item B<close_lex>()
+
+Close most recently opened lexical scope
+
+=item B<store_lex>(in PMC, in STR)
+
+Store object $1 as lexical symbol $2. This currently involves
+looking back through the stack of pads to see if there is an
+entry (corresponding to $2) that should be overwritten.
+
+=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 +3631,80 @@
Find the global named $2 and store it in $1
=cut
+
+op open_lex() {
+ 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 close_lex() {
+ stack_pop(interpreter, &interpreter->ctx.pad_stack, NULL, STACK_ENTRY_DESTINATION);
+ goto NEXT();
+}
+
+op store_lex(in PMC, in STR) {
+ Stack_Chunk_t *cur_stack;
+ Stack_Entry_t *entry = NULL;
+ PMC * cur_hash = NULL;
+ PMC * found = NULL;
+ unsigned int i;
+ KEY key;
+ Stack_entry_type type = 0;
+
+ MAKE_KEY(key, $2, enum_key_string, struct_val);
+
+ /* walk back through stack of pads for the key */
+ cur_stack = interpreter->ctx.pad_stack;
+ while (cur_stack) {
+ if (cur_stack->buffer) {
+ entry = (Stack_Entry_t *)(cur_stack->buffer->bufstart);
+ for (i = 0; i < cur_stack->used; i++) {
+ cur_hash = (PMC *)entry[i].entry.pmc_val;
+ found = cur_hash->vtable->get_pmc_keyed(interpreter, cur_hash, &key);
+ if (found) break;
+ }
+ }
+ cur_stack = cur_stack->prev;
+ }
+
+ if (!found) { /* set the top pad to be cur_hash */
+ cur_hash = (PMC *)stack_peek(interpreter, interpreter->ctx.pad_stack, &type);
+ }
+ cur_hash->vtable->set_pmc_keyed(interpreter, cur_hash, NULL, $1, &key);
+
+ goto NEXT();
+}
+
+op find_lex(out PMC, in STR) {
+ Stack_Chunk_t *cur_stack;
+ Stack_Entry_t *entry = NULL;
+ PMC * cur_hash = NULL;
+ PMC * found = NULL;
+ unsigned int i;
+ KEY key;
+
+ MAKE_KEY(key, $2, enum_key_string, struct_val);
+
+ cur_stack = interpreter->ctx.pad_stack;
+ while (cur_stack) {
+ if (cur_stack->buffer) {
+ entry = (Stack_Entry_t *)(cur_stack->buffer->bufstart);
+ for (i = 0; i < cur_stack->used; i++) {
+ cur_hash = (PMC *)entry[i].entry.pmc_val;
+ found = cur_hash->vtable->get_pmc_keyed(interpreter, cur_hash, &key);
+ if (found) break;
+ }
+ }
+ cur_stack = cur_stack->prev;
+ }
+
+ /* found will still be NULL if key was not found
+ * FIXME: should the not found case be an internal_exception ? */
+ $1 = found;
+ 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 29 Jul 2002 23:03:24 -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 29 Jul 2002 23:03:25 -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 29 Jul 2002 23:03:25 -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");
open_lex
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
open_lex
store_lex P0, "a"
find_lex P3, "a"
print P3
print "\\n"
open_lex
store_lex P1, "b"
store_lex P1, "a"
open_lex
store_lex P2, "c"
find_lex P3, "a"
print P3
print "\\n"
find_lex P3, "b"
print P3
print "\\n"
close_lex
close_lex
find_lex P3, "a"
print P3
print "\\n"
GOOD:
end
CODE
0
1
1
1
OUTPUT
1; # HONK
#
# lexicals.pasm
#
# A program to demonstrate lexical scopes.
#
# $Id: $
#
new P0, .PerlInt
new P1, .PerlInt
new P2, .PerlInt
new P3, .PerlInt
set P0, 10
set P1, 11
set P2, 12
# outer most lexical scope
open_lex
store_lex P0, "a"
find_lex P3, "a"
print P3 # prints 10
print "\n"
# nested lexical scope
open_lex
store_lex P1, "b"
find_lex P3, "b"
print P3 # prints 11
print "\n"
store_lex P2, "a" # overwrites previous "a"
find_lex P3, "a"
print P3 # prints 12
print "\n"
close_lex # end of nested lexical scope
find_lex P3, "a"
print P3 # prints 12
print "\n"
end
