Author: fperrad
Date: Sat Jan 10 04:09:00 2009
New Revision: 35337
Modified:
trunk/languages/lua/src/lib/luaaux.pir
trunk/languages/lua/src/lib/luadebug.pir
trunk/languages/lua/src/pmc/lua.pmc
Log:
[Lua]
- implement traceback() 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 04:09:00 2009
@@ -1024,11 +1024,6 @@
.sub 'where' :anon
# dummy implementation
.return ("_._:0:")
- # previous one that segfaults (see RT #60206)
- .local pmc obj
- new obj, 'Lua'
- $S0 = obj.'where'()
- .return ($S0)
.end
.sub 'traceback' :anon
Modified: trunk/languages/lua/src/lib/luadebug.pir
==============================================================================
--- trunk/languages/lua/src/lib/luadebug.pir (original)
+++ trunk/languages/lua/src/lib/luadebug.pir Sat Jan 10 04:09:00 2009
@@ -363,7 +363,7 @@
string is appended at the beginning of the traceback. This function is
typically used with C<xpcall> to produce better error messages.
-STILL INCOMPLETE (see traceback in lua.pmc).
+STILL INCOMPLETE.
=cut
@@ -377,14 +377,41 @@
unless $S1 goto L1
$S1 .= "\n"
L1:
- new $P0, 'Lua'
- $S0 = $P0.'traceback'($I2)
+ $S0 = _traceback($I2)
$S1 .= $S0
new res, 'LuaString'
set res, $S1
.return (res)
.end
+.sub '_traceback' :anon
+ .param int level
+ $P0 = getinterp
+ $I0 = 0
+ $S0 = "stack traceback:"
+ .local pmc sub, outer
+ L1:
+ inc $I0
+ push_eh _handler
+ sub = $P0['sub'; $I0]
+ pop_eh
+ outer = sub.'get_outer'()
+ $S0 .= "\n\t"
+ unless null outer goto L3
+ $S0 .= "[PIR]:"
+ goto L4
+ L3:
+ $S0 .= "_._:0:"
+ L4:
+ $S0 .= " in function '"
+ $S1 = sub.'get_name'()
+ $S0 .= $S1
+ $S0 .= "'"
+ goto L1
+ _handler:
+ .return ($S0)
+.end
+
=back
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 04:09:00 2009
@@ -31,24 +31,6 @@
static PMC * Lua_PMC;
-static STRING*
-context_infostr(PARROT_INTERP, Parrot_Context *ctx)
-{
- Parrot_Context_info info;
- STRING *res = NULL;
-
- Parrot_block_GC_mark(interp);
-
- if (Parrot_Context_get_info(interp, ctx, &info)) {
- res = Parrot_sprintf_c(interp, "\t%Ss:%d in function '%Ss'\n",
- info.file, info.line, info.subname);
- }
-
- Parrot_unblock_GC_mark(interp);
-
- return res;
-}
-
pmclass Lua
singleton
@@ -235,100 +217,7 @@
RETURN(STRING *retval);
}
-/*
-
-=item C<STRING* traceback(INTVAL level)>
-
-=cut
-
-*/
- METHOD STRING* traceback(INTVAL level) {
- STRING *bt = string_from_literal(INTERP, "stack traceback:\n");
- STRING *str;
-
- /* information about the current sub */
- Parrot_Context *sub_ctx = CONTEXT(interp)->caller_ctx;
-
- if (level == 0) {
- str = context_infostr(INTERP, sub_ctx);
- bt = string_append(INTERP, bt, str);
- }
-
- /* backtrace: follow the continuation chain */
- while (1) {
- PMC *cont = sub_ctx->current_cont;
-
-
- if (!cont)
- break;
-
- sub_ctx = PMC_cont(cont)->to_ctx;
-
- if (!sub_ctx)
- break;
-
- str = context_infostr(INTERP, sub_ctx);
-
-
- if (!str)
- break;
-
- bt = string_append(INTERP, bt, str);
- }
-
- RETURN(STRING *bt);
- }
-
-/*
-
-=item C<STRING* where()>
-
-=cut
-
-*/
- METHOD STRING* where() {
- Parrot_Context *sub_ctx = CONTEXT(interp)->caller_ctx;
- STRING *retval;
-
- /* backtrace: follow the continuation chain */
- while (1) {
- PMC *cont;
- PMC *sub = sub_ctx->current_sub;
- if (sub
- && PMC_metadata(sub)
- && VTABLE_isa(INTERP, sub, const_string(INTERP, "LuaFunction"))) {
- Parrot_Context_info info;
- Parrot_block_GC_mark(INTERP);
-
- if (Parrot_Context_get_info(INTERP, sub_ctx, &info)) {
- STRING *res = Parrot_sprintf_c(INTERP, "%Ss:%d:",
- info.file, info.line);
-
- Parrot_unblock_GC_mark(INTERP);
- RETURN(STRING *res);
- }
- 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, "_._:0:");
- RETURN(STRING *retval);
- }
-
}
-
/*
=back
