Re: Can't make a stack from a continuation

[Neil Jerram]

Neil Jerram wrote:
> address@hidden:~$ guile -q
> guile> (version)
> "1.6.4"
> guile> (call-with-current-continuation make-stack)
> Segmentation fault

I believe I have the fix for this (diffs attached for 1.6.x).  Would 
anyone who feels half-confident in this area please review?

Thanks,
        Neil

Index: libguile/stacks.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/stacks.c,v
retrieving revision 1.64.2.4
diff -u -u -r1.64.2.4 stacks.c
--- libguile/stacks.c   15 Mar 2002 10:33:37 -0000      1.64.2.4
+++ libguile/stacks.c   25 Nov 2004 19:43:20 -0000
@@ -162,10 +162,11 @@
       if (SCM_EVALFRAMEP (*dframe))
        {
          scm_t_debug_info * info = RELOC_INFO (dframe->info, offset);
-         n += (info - dframe->vect) / 2 + 1;
+         scm_t_debug_info * vect = RELOC_INFO (dframe->vect, offset);
+         n += (info - vect) / 2 + 1;
          /* Data in the apply part of an eval info frame comes from previous
             stack frame if the scm_t_debug_info vector is overflowed. */
-         if ((((info - dframe->vect) & 1) == 0)
+         if ((((info - vect) & 1) == 0)
              && SCM_OVERFLOWP (*dframe)
              && !SCM_UNBNDP (info[1].a.proc))
            ++n;
@@ -174,7 +175,7 @@
        ++n;
     }
   if (dframe && SCM_VOIDFRAMEP (*dframe))
-    *id = dframe->vect[0].id;
+    *id = RELOC_INFO (dframe->vect, offset) -> id;
   else if (dframe)
     *maxp = 1;
   return n;
@@ -189,7 +190,8 @@
   if (SCM_EVALFRAMEP (*dframe))
     {
       scm_t_debug_info * info = RELOC_INFO (dframe->info, offset);
-      if ((info - dframe->vect) & 1)
+      scm_t_debug_info * vect = RELOC_INFO (dframe->vect, offset);
+      if ((info - vect) & 1)
        {
          /* Debug.vect ends with apply info. */
          --info;
@@ -206,9 +208,10 @@
     }
   else
     {
+      scm_t_debug_info * vect = RELOC_INFO (dframe->vect, offset);
       flags |= SCM_FRAMEF_PROC;
-      iframe->proc = dframe->vect[0].a.proc;
-      iframe->args = dframe->vect[0].a.args;
+      iframe->proc = vect[0].a.proc;
+      iframe->args = vect[0].a.args;
     }
   iframe->flags = flags;
 }
@@ -254,6 +257,7 @@
 {
   scm_t_info_frame *iframe = iframes;
   scm_t_debug_info *info;
+  scm_t_debug_info *vect;
   static SCM applybody = SCM_UNDEFINED;
   
   /* The value of applybody has to be setup after r4rs.scm has executed. */
@@ -275,7 +279,8 @@
              --iframe;
            }
          info =  RELOC_INFO (dframe->info, offset);
-         if ((info - dframe->vect) & 1)
+         vect =  RELOC_INFO (dframe->vect, offset);
+         if ((info - vect) & 1)
            --info;
          /* Data in the apply part of an eval info frame comes from
             previous stack frame if the scm_t_debug_info vector is
@@ -292,7 +297,7 @@
            iframe->flags |= SCM_FRAMEF_OVERFLOW;
          info -= 2;
          NEXT_FRAME (iframe, n, quit);
-         while (info >= dframe->vect)
+         while (info >= vect)
            {
              if (!SCM_UNBNDP (info[1].a.proc))
                {
@@ -462,8 +467,7 @@
     }
   else if (SCM_CONTINUATIONP (obj))
     {
-      offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof 
(scm_t_contregs))
-               - SCM_BASE (obj));
+      offset = (SCM_CONTREGS (obj) -> stack) - SCM_BASE (obj);
 #ifndef STACK_GROWS_UP
       offset += SCM_CONTINUATION_LENGTH (obj);
 #endif
@@ -490,7 +494,7 @@
   SCM_STACK (stack) -> frames = iframe;
 
   /* Translate the current chain of stack frames into debugging information. */
-  n = read_frames (RELOC_FRAME (dframe, offset), offset, n, iframe);
+  n = read_frames (dframe, offset, n, iframe);
   SCM_STACK (stack) -> length = n;
 
   /* Narrow the stack according to the arguments given to scm_make_stack. */
@@ -546,8 +550,7 @@
     }
   else if (SCM_CONTINUATIONP (stack))
     {
-      offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof 
(scm_t_contregs))
-               - SCM_BASE (stack));
+      offset = (SCM_CONTREGS (stack) -> stack) - SCM_BASE (stack);
 #ifndef STACK_GROWS_UP
       offset += SCM_CONTINUATION_LENGTH (stack);
 #endif
@@ -565,7 +568,7 @@
   while (dframe && !SCM_VOIDFRAMEP (*dframe))
     dframe = RELOC_FRAME (dframe->prev, offset);
   if (dframe && SCM_VOIDFRAMEP (*dframe))
-    return dframe->vect[0].id;
+    return RELOC_INFO (dframe->vect, offset) -> id;
   return SCM_BOOL_F;
 }
 #undef FUNC_NAME
@@ -625,8 +628,7 @@
     }
   else if (SCM_CONTINUATIONP (obj))
     {
-      offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof 
(scm_t_contregs))
-               - SCM_BASE (obj));
+      offset = (SCM_CONTREGS (obj) -> stack) - SCM_BASE (obj);
 #ifndef STACK_GROWS_UP
       offset += SCM_CONTINUATION_LENGTH (obj);
 #endif

Index: test-suite/tests/eval.test
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/test-suite/tests/eval.test,v
retrieving revision 1.6.2.1
diff -u -u -r1.6.2.1 eval.test
--- test-suite/tests/eval.test  19 Jul 2001 20:49:34 -0000      1.6.2.1
+++ test-suite/tests/eval.test  25 Nov 2004 19:43:20 -0000
@@ -177,4 +177,26 @@
        (map + '(1 2) '(3)))
     )))
 
+;;;
+;;; continuations
+;;;
+
+(with-test-prefix "continuation"
+
+  (with-test-prefix "stacks/debugging"
+
+    (debug-enable 'debug)
+
+    (pass-if "make-stack"
+      (stack? (call-with-current-continuation make-stack)))
+
+    (pass-if "stack-id"
+      (let ((id (call-with-current-continuation stack-id)))
+       (or (boolean? id) (symbol? id))))
+
+    (pass-if "last-stack-frame"
+      (pair? (call-with-current-continuation last-stack-frame)))
+
+    ))
+
 ;;; eval.test ends here