[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