Re: Broken Backtraces, and Part of a Solution

[Noah Lavine <noah.b.lavine@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1440 bytes --]

Here's a patch that fixes the bug for me. I'd also like to add a test
suite for the stack functions, to make sure this doesn't happen again,
but I'll look at that later.

Noah

On Wed, Apr 18, 2012 at 9:36 PM, Andy Wingo <wingo@pobox.com> wrote:
> On Wed 18 Apr 2012 18:08, Noah Lavine <noah.b.lavine@gmail.com> writes:
>
>>> We need to change to default to consider generic objects as
>>> eq?-compared prompt tags.
>>
>> I agree, but you still couldn't use procedures or integers as prompt
>> tags if you wanted make-stack to work, because those are special
>> cases.
>
> Yeah, but the whole point of prompt tags is that you can make a new one
> and know that it is eq?-unique, which is not the case for integers.  So
> integers are not in the general case.  It seems useful to add procedures
> as a special case too, no?
>
>> That's why I thought of just changing the interface to make-stack to
>> specify what you want - it's such a weird restriction that someone
>> could be bitten by it and have a lot of trouble tracking it down. And
>> because an argument can mean three different things, code that uses
>> make-stack is hard to understand (or at least it was for me).
>
> It's something of a nasty interface, I agree.  But it's been around for
> a long time; if we can make a minimal change, we should, it seems to me.
>
> Want to make a patch?
>
> Regards,
>
> Andy
> --
> http://wingolog.org/

[-- Attachment #2: 0001-make-stack-handles-prompt-tags-better.patch --]
[-- Type: application/octet-stream, Size: 4375 bytes --]

From d1beca7eac1958ee786f01af13df732c212cfd07 Mon Sep 17 00:00:00 2001
From: Noah Lavine <noah.b.lavine@gmail.com>
Date: Wed, 18 Apr 2012 22:10:21 -0400
Subject: [PATCH] make-stack handles prompt tags better

* libguile/stacks.c: update make-stack and narrow_stack to handle
  prompt tags that are not symbols.
---
 libguile/stacks.c |   66 ++++++++++++++++++++++++++--------------------------
 1 files changed, 33 insertions(+), 33 deletions(-)

diff --git a/libguile/stacks.c b/libguile/stacks.c
index 13d347a..3f3f132 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -109,7 +109,7 @@ find_prompt (SCM key)
 }
 
 static void
-narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
+narrow_stack (SCM stack, SCM inner_cut, SCM outer_cut)
 {
   unsigned long int len;
   SCM frame;
@@ -118,57 +118,67 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
   frame = SCM_STACK_FRAME (stack);
 
   /* Cut inner part. */
-  if (scm_is_true (scm_procedure_p (inner_key)))
+  if (scm_is_true (scm_procedure_p (inner_cut)))
     {
       /* Cut until the given procedure is seen. */
-      for (; inner && len ; --inner)
+      for (; len ;)
         {
           SCM proc = scm_frame_procedure (frame);
           len--;
           frame = scm_frame_previous (frame);
-          if (scm_is_eq (proc, inner_key))
+          if (scm_is_eq (proc, inner_cut))
             break;
         }
     }
-  else if (scm_is_symbol (inner_key))
-    {
-      /* Cut until the given prompt tag is seen. FIXME, assumes prompt tags are
-         symbols. */
-      SCM *fp = find_prompt (inner_key);
-      for (; len; len--, frame = scm_frame_previous (frame))
-        if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
-          break;
-    }
-  else
+  else if (scm_is_integer (inner_cut))
     {
       /* Cut specified number of frames. */
+      long inner = scm_to_int (inner_cut);
+      
       for (; inner && len; --inner)
         {
           len--;
           frame = scm_frame_previous (frame);
         }
     }
+  else
+    {
+      /* Cut until the given prompt tag is seen. */
+      SCM *fp = find_prompt (inner_cut);
+      for (; len; len--, frame = scm_frame_previous (frame))
+        if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
+          break;
+    }
 
   SCM_SET_STACK_LENGTH (stack, len);
   SCM_SET_STACK_FRAME (stack, frame);
 
   /* Cut outer part. */
-  if (scm_is_true (scm_procedure_p (outer_key)))
+  if (scm_is_true (scm_procedure_p (outer_cut)))
     {
       /* Cut until the given procedure is seen. */
-      for (; outer && len ; --outer)
+      for (; len ;)
         {
           frame = scm_stack_ref (stack, scm_from_long (len - 1));
           len--;
-          if (scm_is_eq (scm_frame_procedure (frame), outer_key))
+          if (scm_is_eq (scm_frame_procedure (frame), outer_cut))
             break;
         }
     }
-  else if (scm_is_symbol (outer_key))
+  else if (scm_is_integer (outer_cut))
+    {
+      /* Cut specified number of frames. */
+      long outer = scm_to_int (outer_cut);
+      
+      if (outer < len)
+        len -= outer;
+      else
+        len = 0;
+    }
+  else
     {
-      /* Cut until the given prompt tag is seen. FIXME, assumes prompt tags are
-         symbols. */
-      SCM *fp = find_prompt (outer_key);
+      /* Cut until the given prompt tag is seen. */
+      SCM *fp = find_prompt (outer_cut);
       while (len)
         {
           frame = scm_stack_ref (stack, scm_from_long (len - 1));
@@ -177,14 +187,6 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
             break;
         }
     }
-  else
-    {
-      /* Cut specified number of frames. */
-      if (outer < len)
-        len -= outer;
-      else
-        len = 0;
-    }
 
   SCM_SET_STACK_LENGTH (stack, len);
 }
@@ -308,10 +310,8 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
 	}
       
       narrow_stack (stack,
-		    scm_is_integer (inner_cut) ? scm_to_int (inner_cut) : n,
-		    scm_is_integer (inner_cut) ? SCM_BOOL_T : inner_cut,
-		    scm_is_integer (outer_cut) ? scm_to_int (outer_cut) : n,
-		    scm_is_integer (outer_cut) ? SCM_BOOL_T : outer_cut);
+                    inner_cut,
+                    outer_cut);
 
       n = SCM_STACK_LENGTH (stack);
     }
-- 
1.7.6