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
