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

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

From:
fperrad
Date:
January 10, 2009 04:09
Subject:
[svn:parrot] r35337 - in trunk/languages/lua/src: lib pmc
Message ID:
20090110120901.78A23CB9F9@x12.develooper.com
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



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