Fix continuation marking, and some tests.

* libguile/continuations.c (continuation_mark): Mark the vm
  continuations.

* libguile/vm.c (vm_cont_mark): Fix the marking function.
  (vm_mark): Fix this one too -- the size is a number of STACKITEMS,
  which we foolishly assume are the same size as SCM.

* test-suite/tests/ftw.test: Make our stat hacks verifyable without
  assuming that they are interpreted.

* test-suite/tests/r5rs_pitfall.test: Re-indent.

libguile/continuations.c

@@ -51,6 +51,7 @@ continuation_mark (SCM obj)
 
   scm_gc_mark (continuation->root);
   scm_gc_mark (continuation->throw_value);
+  scm_gc_mark (continuation->vm_conts);
   scm_mark_locations (continuation->stack, continuation->num_stack_items);
 #ifdef __ia64__
   if (continuation->backing_store)

libguile/vm.c

@@ -80,16 +80,14 @@ struct scm_vm_cont {
 static SCM
 vm_cont_mark (SCM obj)
 {
-  scm_t_ptrdiff i, size;
+  size_t size;
   SCM *stack;
 
   stack = SCM_VM_CONT_DATA (obj)->stack_base;
   size = SCM_VM_CONT_DATA (obj)->stack_size;
 
   /* we could be smarter about this. */
-  for (i = 0; i < size; i ++)
+  scm_mark_locations ((SCM_STACKITEM *) stack, size);
-    if (SCM_NIMP (stack[i]))
-      scm_gc_mark (stack[i]);
 
   return SCM_BOOL_F;
 }
@@ -333,7 +331,7 @@ vm_mark (SCM obj)
 
   /* mark the stack conservatively */
   scm_mark_locations ((SCM_STACKITEM *) vp->stack_base,
-		      sizeof (SCM) * (vp->sp - vp->stack_base + 1));
+                      vp->sp - vp->stack_base + 1);
 
   /* mark other objects  */
   for (i = 0; i < SCM_VM_NUM_HOOKS; i++)

test-suite/tests/ftw.test

@@ -25,18 +25,19 @@
 ;; what ice-9/posix.scm stat:dev and stat:ino do (which in turn match
 ;; libguile/filesys.c of course)
 
-(or (equal? (procedure-source stat:dev)
-	    '(lambda (f) (vector-ref f 0)))
-    (error "oops, unexpected stat:dev definition"))
 (define (stat:dev! st dev)
   (vector-set! st 0 dev))
-
-(or (equal? (procedure-source stat:ino)
-	    '(lambda (f) (vector-ref f 1)))
-    (error "oops, unexpected stat:ino definition"))
 (define (stat:ino! st ino)
   (vector-set! st 1 ino))
 
+(let* ((s (stat "/"))
+       (i (stat:ino s))
+       (d (stat:dev s)))
+  (stat:ino! s (1+ i))
+  (stat:dev! s (1+ d))
+  (if (not (and (= (stat:ino s) (1+ i))
+                (= (stat:dev s) (1+ d))))
+      (error "unexpected definitions of stat:dev and stat:ino")))
 
 ;;
 ;; visited?-proc

test-suite/tests/r5rs_pitfall.test

@@ -27,15 +27,15 @@
   (syntax-rules ()
     ((_ test-id value expression)
      (run-test test-id #t (lambda ()
-			    (false-if-exception
+                            (false-if-exception
-			     (equal? expression value)))))))
+                             (equal? expression value)))))))
 
 (define-syntax should-be-but-isnt
   (syntax-rules ()
     ((_ test-id value expression)
      (run-test test-id #f (lambda ()
-			    (false-if-exception
+                            (false-if-exception
-			     (equal? expression value)))))))
+                             (equal? expression value)))))))
 
 (define call/cc call-with-current-continuation)
 
@@ -65,7 +65,7 @@
 (should-be 1.2 #t
   (letrec ((x (call/cc list)) (y (call/cc list)))
     (cond ((procedure? x) (x (pair? y)))
-	  ((procedure? y) (y (pair? x))))
+          ((procedure? y) (y (pair? x))))
     (let ((x (car x)) (y (car y)))
       (and (call/cc x) (call/cc y) (call/cc x)))))
 
@@ -75,11 +75,11 @@
 ;; http://groups.google.com/groups?selm=19890302162742.4.ALAN%40PIGPEN.AI.MIT.EDU
 (should-be 1.3 #t
   (letrec ((x (call-with-current-continuation
-		  (lambda (c)
+                  (lambda (c)
-		    (list #T c)))))
+                    (list #T c)))))
       (if (car x)
-	  ((cadr x) (list #F (lambda () x)))
+          ((cadr x) (list #F (lambda () x)))
-	  (eq? x ((cadr x))))))
+          (eq? x ((cadr x))))))
 
 ;; Section 2: Proper call/cc and procedure application
 
@@ -300,12 +300,12 @@
     (define res1 #f)
     (define res2 #f)
     (set! res1 (map (lambda (x)
-		      (if (= x 0)
+                      (if (= x 0)
-			  (call/cc (lambda (k) (set! cont k) 0))
+                          (call/cc (lambda (k) (set! cont k) 0))
-			  0))
+                          0))
-		    '(1 0 2)))
+                    '(1 0 2)))
     (if (not executed-k)           
-	(begin (set! executed-k #t) 
+        (begin (set! executed-k #t) 
-	       (set! res2 res1)
+               (set! res2 res1)
-	       (cont 1)))
+               (cont 1)))
     res2))