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