Re: Can't make a stack from a continuation

[Neil Jerram <neil@ossau.uklinux.net>]

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

Neil Jerram wrote:
> neil@laruns:~$ 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

[-- Attachment #2: stacks.c.diff --]
[-- Type: text/x-patch, Size: 4239 bytes --]

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

[-- Attachment #3: eval.test.diff --]
[-- Type: text/x-patch, Size: 899 bytes --]

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

[-- Attachment #4: Type: text/plain, Size: 137 bytes --]

_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://lists.gnu.org/mailman/listinfo/bug-guile