develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35335 - in trunk/languages/lua/src: lib pmc

From:
fperrad
Date:
January 10, 2009 02:47
Subject:
[svn:parrot] r35335 - in trunk/languages/lua/src: lib pmc
Message ID:
20090110104741.14059CB9F9@x12.develooper.com
Author: fperrad
Date: Sat Jan 10 02:47:37 2009
New Revision: 35335

Modified:
   trunk/languages/lua/src/lib/luaaux.pir
   trunk/languages/lua/src/pmc/lua.pmc

Log:
[Lua]
- implement caller() in pure PIR
- remove previous implementation in PMC Lua

Modified: trunk/languages/lua/src/lib/luaaux.pir
==============================================================================
--- trunk/languages/lua/src/lib/luaaux.pir	(original)
+++ trunk/languages/lua/src/lib/luaaux.pir	Sat Jan 10 02:47:37 2009
@@ -42,11 +42,25 @@
     .param int narg
     .param pmc extramsg :slurpy
     $S1 = narg
-    new $P0, 'Lua'
-    $S0 = $P0.'caller'()
+    $S0 = caller()
     .tailcall lua_x_error("bad argument #", $S1, " to '", $S0, "' (", extramsg :flat, ")")
 .end
 
+.sub 'caller' :anon
+    $P0 = getinterp
+    $I0 = 0
+  L1:
+    inc $I0
+    push_eh _handler
+    $P1 = $P0['sub'; $I0]
+    pop_eh
+    $P2 = $P1.'getfenv'()
+    unless $P2 goto L1
+    $S0 = $P1.'get_name'()
+    .return ($S0)
+  _handler:
+    .return ("?")
+.end
 
 =item C<lua_checkany (narg, arg)>
 

Modified: trunk/languages/lua/src/pmc/lua.pmc
==============================================================================
--- trunk/languages/lua/src/pmc/lua.pmc	(original)
+++ trunk/languages/lua/src/pmc/lua.pmc	Sat Jan 10 02:47:37 2009
@@ -101,50 +101,6 @@
 
 /*
 
-=item C<STRING* caller()>
-
-=cut
-
-*/
-    METHOD STRING* caller() {
-        Parrot_Context   *sub_ctx = CONTEXT(interp)->caller_ctx;
-        STRING           *retval;
-
-        /* backtrace: follow the continuation chain */
-        while (1) {
-            PMC *cont;
-            if (sub_ctx->current_sub && PMC_metadata(sub_ctx->current_sub)) {
-                Parrot_Context_info info;
-                Parrot_block_GC_mark(INTERP);
-
-                if (Parrot_Context_get_info(INTERP, sub_ctx, &info)) {
-                    STRING *retval = info.subname;
-
-                    Parrot_unblock_GC_mark(INTERP);
-                    RETURN(STRING *retval);
-                }
-                Parrot_unblock_GC_mark(INTERP);
-                break;
-            }
-
-            cont = sub_ctx->current_cont;
-
-
-            if (!cont)
-                break;
-
-            sub_ctx = PMC_cont(cont)->to_ctx;
-
-            if (!sub_ctx)
-                break;
-        }
-
-        retval = const_string(INTERP, "?");
-        RETURN(STRING *retval);
-    }
-
-/*
-
 =item C<PMC* clock()>
 
 =cut



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About