# New Ticket Created by Jonathan Sillito
# Please include the string: [perl #16797]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=16797 >
This patch supersedes patch [perl #16087], which will not apply
correctly, since key stuff has changed.
I realize Dan has not given official word on how lexicals/closures are
to work yet (unless I missed it?), but I thought I would implement some
stuff anyway. I don't mind if I have to rework it when Dan gets to this
(probably not until sometime after the 0.0.8 release, I suppose?).
Anyway, this patch has two main goals. The first is to give scratchpads
a pointer to their parent pad. In the process I added a Scratchpad pmc
that uses its data pointer to point to a PerlHash (temporarily?) and
uses its cache pointer to point to its parent. I am not sure about this
use of the cache pointer, but it is only used internally so it should be
easy to change.
The scratchpad.pmc file is attached.
The second goal is to make subs closures. Below is an example of how
this works. You will notice that at the end of each sub there is an
extra 'pop_pad', this is to remove the pad that is pushed on the
pad_stack when the sub is invoked (or should the ret op take care of
this?).
new_pad
new P0, .Sub
set_addr I3, get_closure
set P0, I3
invoke
# move returned sub pmc to P0, then invoke twice
set P0, P5
# invoke puts correct scratch pad on top of stack
invoke
invoke
find_lex P6, "a"
print P6 # should be undef which prints as ''
print "\n"
pop_pad
end
# a sub that returns a sub (closure)
get_closure:
new_pad
print "called get_closure\n"
new P10, .PerlInt
set P10, 57
store_lex "a", P10
# sub grabs current current pad when created
new P5, .Sub
set_addr I5, closure
set P5, I5
# returning sub pmc in first return pmc register,
# which is P5
set I5, 1
pop_pad
pop_pad # extra pad needs to be poped
ret
closure:
print "called closure\n"
find_lex P2, "a"
print P2
print "\n"
pop_pad # extra pad needs to be poped
ret
produces the output:
called get_closure
called closure
57
called closure
57
The attached file closure.patch has the following effects:
- changes lexical ops in core.ops to use Scratchpad pmc,
and to use keys properly.
- adds Scratchpad to enum in include/parrot/pmc.h
- adds Parrot_Scratchpad_class_init(enum_class_Scratchpad);
to global_setup.c
- adds additional test to t/op/lexicals.t
- adds additional test to t/pmc/sub.t
- fixes examples/assembly/lexical.pasm (reverses PMC and
string arguments to store_lex op).
- changes new_sub method in sub.c
- changes invoke in sub.pmc (to put pad in place)
Comments?
--
Jonathan Sillito
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/35844/29037/feda4d/closure.patch
-- attachment 2 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/35844/29038/d0f8a9/scratchpad.pmc
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.203
diff -u -r1.203 core.ops
--- core.ops 23 Aug 2002 17:21:38 -0000 1.203
+++ core.ops 27 Aug 2002 20:47:43 -0000
@@ -3523,8 +3523,8 @@
=cut
op new_pad() {
- PMC* hash = pmc_new(interpreter, enum_class_PerlHash);
- stack_push(interpreter, &interpreter->ctx.pad_stack, hash, STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
+ PMC * pad = pmc_new(interpreter, enum_class_Scratchpad);
+ stack_push(interpreter, &interpreter->ctx.pad_stack, pad, STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
goto NEXT();
}
@@ -3535,22 +3535,27 @@
}
op store_lex(in STR, in PMC) {
- PMC * hash = NULL;
+ PMC * pad;
PMC * key = key_new_string(interpreter, $1);
- Stack_entry_type type = NO_STACK_ENTRY_TYPE;
- hash = (PMC *)stack_peek(interpreter, interpreter->ctx.pad_stack, &type);
- hash->vtable->set_pmc_keyed(interpreter, hash, key, $2, NULL);
+ Stack_entry_type type = 0;
+ pad = (PMC *)stack_peek(interpreter, interpreter->ctx.pad_stack, &type);
+ pad->vtable->set_pmc_keyed(interpreter, pad, key, $2, NULL);
goto NEXT();
}
op find_lex(out PMC, in STR) {
- PMC * hash = NULL;
+ PMC * pad;
PMC * key = key_new_string(interpreter, $2);
- Stack_entry_type type = NO_STACK_ENTRY_TYPE;
- 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 ? */
+ Stack_entry_type type = 0;
+ pad = (PMC *)stack_peek(interpreter, interpreter->ctx.pad_stack, &type);
+ if (!pad) {
+ /* really a compiler error, I guess */
+ internal_exception(INTERP_ERROR,
+ "No scratchpad to find from (missing new_pad?)");
+ }
+ else {
+ $1 = pad->vtable->get_pmc_keyed(interpreter, pad, key);
+ }
goto NEXT();
}
Index: global_setup.c
===================================================================
RCS file: /cvs/public/parrot/global_setup.c,v
retrieving revision 1.34
diff -u -r1.34 global_setup.c
--- global_setup.c 19 Aug 2002 23:14:48 -0000 1.34
+++ global_setup.c 27 Aug 2002 20:47:44 -0000
@@ -37,6 +37,7 @@
Parrot_Continuation_class_init(enum_class_Continuation);
Parrot_MultiArray_class_init(enum_class_MultiArray);
Parrot_Key_class_init(enum_class_Key);
+ Parrot_Scratchpad_class_init(enum_class_Scratchpad);
/* Now register the names of the PMCs */
Index: sub.c
===================================================================
RCS file: /cvs/public/parrot/sub.c,v
retrieving revision 1.7
diff -u -r1.7 sub.c
--- sub.c 22 Aug 2002 14:24:05 -0000 1.7
+++ sub.c 27 Aug 2002 20:47:44 -0000
@@ -31,10 +31,11 @@
struct Parrot_Sub *
new_sub(struct Parrot_Interp * interp, opcode_t * address)
{
+ Stack_entry_type type = 0;
/* 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 = NULL;
+ newsub->lex_pad = (struct Scratchpad *)stack_peek(interp, interp->ctx.pad_stack, &type);
return newsub;
}
Index: include/parrot/pmc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc.h,v
retrieving revision 1.38
diff -u -r1.38 pmc.h
--- include/parrot/pmc.h 19 Aug 2002 23:15:52 -0000 1.38
+++ include/parrot/pmc.h 27 Aug 2002 20:47:44 -0000
@@ -30,6 +30,7 @@
enum_class_CSub,
enum_class_MultiArray,
enum_class_Key,
+ enum_class_Scratchpad,
enum_class_max = 100
};
VAR_SCOPE VTABLE Parrot_base_vtables[enum_class_max];
Index: t/op/lexicals.t
===================================================================
RCS file: /cvs/public/parrot/t/op/lexicals.t,v
retrieving revision 1.2
diff -u -r1.2 lexicals.t
--- t/op/lexicals.t 6 Aug 2002 22:42:35 -0000 1.2
+++ t/op/lexicals.t 27 Aug 2002 20:47:44 -0000
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 3;
output_is(<<CODE, <<OUTPUT, "simple store and fetch");
new_pad
@@ -53,6 +53,27 @@
0
2
0
+OUTPUT
+
+output_is(<<CODE, <<OUTPUT, "undefined lexicals");
+ new P0, .PerlInt
+ set P0, 30
+
+ # outer most lexical scope
+ new_pad
+
+ # nested lexical scope
+ new_pad
+ store_lex "a", P0
+ pop_pad
+
+ # should be undefined (printing undef does nothing)
+ find_lex P2, "a"
+ print P2
+ print "\\n"
+ end
+CODE
+
OUTPUT
1;
Index: t/pmc/sub.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/sub.t,v
retrieving revision 1.2
diff -u -r1.2 sub.t
--- t/pmc/sub.t 6 Aug 2002 22:43:08 -0000 1.2
+++ t/pmc/sub.t 27 Aug 2002 20:47:44 -0000
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 3;
+use Parrot::Test tests => 4;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "PASM subs");
@@ -47,6 +47,53 @@
0
1 done
done 2
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "PASM closure");
+ new_pad
+ new P0, .Sub
+ set_addr I3, get_closure
+ set P0, I3
+ invoke
+ set P0, P5
+ invoke
+ invoke
+
+ find_lex P6, "a"
+ print P6 # should be undef which prints as nothing
+ print "\n"
+ pop_pad
+ end
+get_closure:
+ new_pad
+ print "called get_closure\n"
+ new P10, .PerlInt
+ set P10, 57
+ store_lex "a", P10
+ new P5, .Sub
+ set_addr I5, closure
+ set P5, I5
+ set I5, 1 # number of PMCs returned
+end_get_closure:
+ pop_pad
+ pop_pad # extra pad needs to be poped
+ ret
+closure:
+ print "called closure\n"
+ find_lex P2, "a"
+ print P2
+ print "\n"
+end_closure:
+ pop_pad # extra pad needs to be poped
+ ret
+
+CODE
+called get_closure
+called closure
+57
+called closure
+57
+
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "Continuations");
Index: examples/assembly/lexical.pasm
===================================================================
RCS file: /cvs/public/parrot/examples/assembly/lexical.pasm,v
retrieving revision 1.1
diff -u -r1.1 lexical.pasm
--- examples/assembly/lexical.pasm 31 Jul 2002 02:48:49 -0000 1.1
+++ examples/assembly/lexical.pasm 27 Aug 2002 20:47:44 -0000
@@ -15,14 +15,14 @@
# outer most lexical scope
new_pad
-store_lex P0, "a"
+store_lex "a", P0
find_lex P3, "a"
print P3 # prints 0
print "\n"
new_pad
-store_lex P1, "b"
-store_lex P1, "a"
+store_lex "b", P1
+store_lex "a", P1
find_lex P3, "a"
print P3 # prints 1
Index: classes/sub.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sub.pmc,v
retrieving revision 1.5
diff -u -r1.5 sub.pmc
--- classes/sub.pmc 4 Aug 2002 22:55:03 -0000 1.5
+++ classes/sub.pmc 27 Aug 2002 20:47:44 -0000
@@ -45,9 +45,16 @@
}
void* invoke (void* next) {
- /* return address that the interpreter should jump to */
+ /* address to return to */
stack_push(INTERP, &(INTERP->ctx.control_stack), next,
STACK_ENTRY_DESTINATION, STACK_CLEANUP_NULL);
+
+ /* fix scratchpad */
+ stack_push(INTERP, &(INTERP->ctx.pad_stack),
+ ((struct Parrot_Sub*)SELF->data)->lex_pad,
+ STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
+
+ /* return address that the interpreter should jump to */
return ((struct Parrot_Sub*)SELF->data)->init;
}
/* Scratchpad.pmc
* Copyright: (When this is determined...it will go here)
* CVS Info
* $Id$
* Overview:
* These are the vtable functions for the Scratchpad base class
* Data Structure and Algorithms:
* SELF->data stores the lexicals
* SELF->cache points to the parent Scratchpad, if there is one
* and is NULL otherwise
* History:
* Initial revision by sillito 2002/08/08
* Notes:
* References:
*/
#include "parrot/parrot.h"
pmclass Scratchpad {
void init () {
/* get parent */
PMC * parent;
Stack_entry_type type = 0;
parent = (PMC *)stack_peek(interpreter, interpreter->ctx.pad_stack, &type);
SELF->cache.pmc_val = parent;
/* temporarily using a hash to store lexicals */
SELF->data = pmc_new(interpreter, enum_class_PerlHash);
SELF->flags |= (PMC_is_PMC_ptr_FLAG | PMC_custom_mark_FLAG);
}
void init_pmc (PMC* initializer) {
}
void morph (INTVAL type) {
}
PMC* mark (PMC* tail) {
/*
* this assumes that the data pointer points to something
* with a customer mark routine, which hash does ...
*/
tail = ((PMC *)SELF->data)->vtable->mark(interpreter,
SELF->data, tail);
if (SELF->cache.pmc_val) {
tail = Parrot_Scratchpad_mark(interpreter, SELF->cache.pmc_val, tail);
}
return tail;
}
void destroy () {
}
INTVAL type () {
return enum_class_Scratchpad;
}
STRING* name () {
return whoami;
}
PMC* get_pmc_keyed (PMC* key) {
PMC * value;
value = ((PMC *)SELF->data)->vtable->get_pmc_keyed(interpreter,
SELF->data, key);
if (value->vtable->type(interpreter, value) == enum_class_PerlUndef &&
SELF->cache.pmc_val) {
value = SELF->cache.pmc_val->vtable->get_pmc_keyed(interpreter,
SELF->cache.pmc_val, key);
}
return value;
}
/* implement this for getting lexicals by position
PMC* get_pmc_keyed_int (INTVAL* key) {
}
*/
void set_pmc_keyed (PMC* key, PMC* value, PMC* value_key) {
((PMC *)SELF->data)->vtable->set_pmc_keyed(interpreter,
SELF->data, key, value, value_key);
}
}
