[svn:parrot] r40984 - in trunk: compilers/pct/src/PAST include/parrot src src/ops t/op
pmichaud at svn.parrot.org
pmichaud at svn.parrot.org
Sat Sep 5 01:34:24 UTC 2009
Author: pmichaud
Date: Sat Sep 5 01:34:21 2009
New Revision: 40984
URL: https://trac.parrot.org/parrot/changeset/40984
Log:
[lexicals]: Add (find|store)_dynamic_lex to support dynamic lexicals
(needed for nqp, pct, and pge updates).
Modified:
trunk/compilers/pct/src/PAST/Compiler.pir
trunk/include/parrot/sub.h
trunk/src/ops/ops.num
trunk/src/ops/var.ops
trunk/src/sub.c
trunk/t/op/lexicals.t
Modified: trunk/compilers/pct/src/PAST/Compiler.pir
==============================================================================
--- trunk/compilers/pct/src/PAST/Compiler.pir Sat Sep 5 01:05:05 2009 (r40983)
+++ trunk/compilers/pct/src/PAST/Compiler.pir Sat Sep 5 01:34:21 2009 (r40984)
@@ -989,6 +989,8 @@
unless $I0 goto have_lvalue
$P0 = node[0]
if null $P0 goto have_lvalue
+ $I1 = exists $P0['lvalue']
+ if $I1 goto have_lvalue
$P0.'lvalue'($I0)
have_lvalue:
Modified: trunk/include/parrot/sub.h
==============================================================================
--- trunk/include/parrot/sub.h Sat Sep 5 01:05:05 2009 (r40983)
+++ trunk/include/parrot/sub.h Sat Sep 5 01:34:21 2009 (r40984)
@@ -260,6 +260,15 @@
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
+PMC* Parrot_find_dynamic_pad(PARROT_INTERP,
+ ARGIN(STRING *lex_name),
+ ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_CAN_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
PMC* Parrot_find_pad(PARROT_INTERP,
ARGIN(STRING *lex_name),
ARGIN(PMC *ctx))
@@ -304,6 +313,10 @@
__attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(cc)
+#define ASSERT_ARGS_Parrot_find_dynamic_pad __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(lex_name) \
+ || PARROT_ASSERT_ARG(ctx)
#define ASSERT_ARGS_Parrot_find_pad __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(lex_name) \
Modified: trunk/src/ops/ops.num
==============================================================================
--- trunk/src/ops/ops.num Sat Sep 5 01:05:05 2009 (r40983)
+++ trunk/src/ops/ops.num Sat Sep 5 01:34:21 2009 (r40984)
@@ -1275,3 +1275,7 @@
find_name_p_sc 1251
find_sub_not_null_p_s 1252
find_sub_not_null_p_sc 1253
+store_dynamic_lex_s_p 1254
+store_dynamic_lex_sc_p 1255
+find_dynamic_lex_p_s 1256
+find_dynamic_lex_p_sc 1257
Modified: trunk/src/ops/var.ops
==============================================================================
--- trunk/src/ops/var.ops Sat Sep 5 01:05:05 2009 (r40983)
+++ trunk/src/ops/var.ops Sat Sep 5 01:34:21 2009 (r40984)
@@ -52,6 +52,35 @@
########################################
+=item B<store_dynamic_lex>(in STR, invar PMC)
+
+Search caller lexpads for lexical symbol $1 and store object $2
+there. Throws an exception if no caller lexpad claims the
+lexical symbol. (To store a value in the current lexpad,
+use C<store_lex> above.)
+
+=cut
+
+op store_dynamic_lex(in STR, invar PMC) {
+ STRING * const lex_name = $1;
+ PMC * const ctx =
+ Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp));
+ PMC * const lex_pad =
+ PMC_IS_NULL(ctx)
+ ? PMCNULL
+ : Parrot_find_dynamic_pad(interp, lex_name, ctx);
+
+ if (PMC_IS_NULL(lex_pad)) {
+ opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
+ EXCEPTION_LEX_NOT_FOUND,
+ "Lexical '%Ss' not found in dynamic scope", lex_name);
+ goto ADDRESS(handler);
+ }
+ VTABLE_set_pmc_keyed_str(interp, lex_pad, lex_name, $2);
+}
+
+########################################
+
=item B<find_lex>(out PMC, in STR)
Find the lexical variable named $2 and store it in $1. This
@@ -81,12 +110,36 @@
########################################
+=item B<find_dynamic_lex>(out PMC, in STR)
+
+Search through caller lexpads for a lexical variable named $2
+and store it in $1. Return a Null PMC if the lexical variable
+is not found. (To search the current lexpad, use C<find_lex>
+above.)
+
+=cut
+
+op find_dynamic_lex(out PMC, in STR) {
+ STRING * const lex_name = $2;
+ PMC * const ctx =
+ Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp));
+ PMC * const lex_pad =
+ PMC_IS_NULL(ctx)
+ ? PMCNULL
+ : Parrot_find_dynamic_pad(interp, lex_name, ctx);
+ PMC * const result =
+ PMC_IS_NULL(lex_pad)
+ ? PMCNULL
+ : VTABLE_get_pmc_keyed_str(interp, lex_pad, lex_name);
+ $1 = result;
+}
+
+########################################
+
=item B<find_caller_lex>(out PMC, in STR)
-Like find_lex above, but searches through callers' lexical
-scopes (scanning up the dynamic chain) instead of the current
-lexical scope. Note that the I<current> lexical scope is not
-included in the search (use C<find_lex> above for that).
+Like find_dynamic_lex above, but also searches caller's
+outer scopes in addition to the lexpads.
=cut
Modified: trunk/src/sub.c
==============================================================================
--- trunk/src/sub.c Sat Sep 5 01:05:05 2009 (r40983)
+++ trunk/src/sub.c Sat Sep 5 01:34:21 2009 (r40984)
@@ -380,7 +380,7 @@
ASSERT_ARGS(Parrot_find_pad)
while (1) {
PMC * const lex_pad = Parrot_pcc_get_lex_pad(interp, ctx);
- PMC *outer = Parrot_pcc_get_outer_ctx(interp, ctx);
+ PMC * outer = Parrot_pcc_get_outer_ctx(interp, ctx);
if (!outer)
return lex_pad;
@@ -396,6 +396,39 @@
/*
+=item C<PMC* Parrot_find_dynamic_pad(PARROT_INTERP, STRING *lex_name, PMC *ctx)>
+
+Locate the LexPad containing the given C<lex_name> in C<ctx> and
+its caller pads. Return PMCNULL on failure.
+
+=cut
+
+*/
+
+PARROT_CAN_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+PMC*
+Parrot_find_dynamic_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_find_dynamic_pad)
+ while (1) {
+ PMC * const lex_pad = Parrot_pcc_get_lex_pad(interp, ctx);
+ PMC * caller = Parrot_pcc_get_caller_ctx(interp, ctx);
+
+ if (!caller)
+ return lex_pad;
+
+ if (!PMC_IS_NULL(lex_pad))
+ if (VTABLE_exists_keyed_str(interp, lex_pad, lex_name))
+ return lex_pad;
+
+ ctx = caller;
+ }
+}
+
+
+/*
+
=item C<void Parrot_capture_lex(PARROT_INTERP, PMC *sub_pmc)>
Capture the current lexical environment of a sub.
Modified: trunk/t/op/lexicals.t
==============================================================================
--- trunk/t/op/lexicals.t Sat Sep 5 01:05:05 2009 (r40983)
+++ trunk/t/op/lexicals.t Sat Sep 5 01:34:21 2009 (r40984)
@@ -14,7 +14,7 @@
plan( skip_all => 'lexicals not thawed properly from PBC, RT #60652' )
if $ENV{TEST_PROG_ARGS} =~ /--run-pbc/;
-plan( tests => 48 );
+plan( tests => 51 );
=head1 NAME
@@ -1493,6 +1493,71 @@
ok 2 - looking up lexical sub
OUTPUT
+pir_output_is( <<'CODE', <<'OUTPUT', 'find_dynamic_lex basic' );
+.sub 'main'
+ $P0 = box 'main'
+ .lex '$*VAR', $P0
+ 'foo'()
+ $P1 = find_dynamic_lex '$*VAR'
+ if null $P1 goto p1_null
+ print 'not '
+ p1_null:
+ say 'null'
+.end
+
+.sub 'foo'
+ $P1 = find_dynamic_lex '$*VAR'
+ say $P1
+.end
+CODE
+main
+null
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "find_dynamic_lex doesn't search outer" );
+.sub 'main'
+ $P0 = box 'main'
+ .lex '$*VAR', $P0
+ 'bar'()
+.end
+
+.sub 'bar'
+ $P0 = box 'bar'
+ .lex '$*VAR', $P0
+ 'foo'()
+.end
+
+.sub 'foo' :outer('main')
+ $P1 = find_dynamic_lex '$*VAR'
+ say $P1
+ $P1 = find_lex '$*VAR'
+ say $P1
+.end
+CODE
+bar
+main
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'find_dynamic_lex two levels deep' );
+.sub 'main'
+ $P0 = box 'main'
+ .lex '$*VAR', $P0
+ 'bar'()
+.end
+
+.sub 'bar'
+ 'foo'()
+.end
+
+.sub 'foo'
+ $P1 = find_dynamic_lex '$*VAR'
+ say $P1
+.end
+CODE
+main
+OUTPUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
More information about the parrot-commits
mailing list