I am using continuations to implement threading for a large program. I am 
seeing corruption of the local variables in one continuation with data from 
another continuation.

I have an example of what I am trying to do attached. The example works as I 
expect, but in the actual program the value of a variable from a let is replace 
with a literal that is passed to a function in the other thread.

Does anyone have any suggestion on how to proceed? Has anyone used 
continuations with bigloo in programs that call into C++ and then yield when 
they get back? I don't ever call back into bigloo from C++ and then yield 
(leaving C++ stack in the continuation) so I thought it would be safe.

Thanks for any pointers.

I am continuing to try to create a simple example that fails.

Todd D.


(define (user-main arg)
   (print "(user-main " arg ")")
   (s-add-client task0 '(data0))
   (s-add-client task1 '(data1)))

(define (task0 x)
   (let ((ebx (list 1 2)))
      (print  "p0  1.(ebx " ebx ")")
      (function-that-yields '(1 2 3))
      ; In actual program, the value for ebx has the value '(4 5 6). Did this come from the other thread?
      (print  "p0  2.(ebx " ebx ")")
      (function-that-yields '(7 8 9))))

(define (task1 x)
   (print "task 1 1.")
   (function-that-yields '(4 5 6))
   (print "task 1 2.")
   (function-that-yields '(5 6 7))
   (print "task 1 3."))
; bigloo -static-all-bigloo -call/cc macro-problem-example.scm -o corrupted-let-problem-example

(module corrupted-let-problem-example
   (export
      (s-add-client . args)
      (function-that-yields arg))
   (eval (export-exports))
   (main main))

(define *s-conts* '()) ; *conts* is a list of pairs. First in pair is continuation. Second is thread specific data
(define *s-thread-data* #f)

(define (s-thread-data)
   *s-thread-data*)

(define (s-yield)
   ;(print "(s-yield)")
   (call-cc s-schedule))

(define (s-thread-exit)
   ;(print "(s-thread-exit)")
   (if (null? *s-conts*)
       #f
       (let* ((next-cont-pair (car *s-conts*))
	      (next-cont (car next-cont-pair)))
	  (set! *s-thread-data* (cdr next-cont-pair))
	  (set! *s-conts* (cdr *s-conts*))
	  ;(print "thread-exit-length " (length *s-conts*))
	  ((next-cont 1)))))

(define (s-add-task f data)
   (set! *s-conts* (cons (cons (lambda (x) (f x) (s-thread-exit)) data) *s-conts*)))

(define (s-go)
   ;(print "(s-go)")
   (set! *s-conts* (reverse *s-conts*))
   (let loop ((x 0))
      (set! *s-thread-data* "go-thread-data")
      (call-cc s-schedule)
      (print "(s-go (thread-exit-length " (length *s-conts*) "))")
      (when (not (= 0 (length *s-conts*)))
	 (loop 0))))

(define (s-schedule new-cont)
   (let ((cont-data-pair (cons new-cont *s-thread-data*)))
      (let* ((tmp-conts (reverse (cons cont-data-pair (reverse *s-conts*))))
	     (next-cont-pair (car tmp-conts))
	     (next-cont (car next-cont-pair)))
	 (set! *s-conts* (cdr tmp-conts))
	 (set! *s-thread-data* (cdr next-cont-pair))
	 ;(print "(s-schedule - run next cont - (next-cont " next-cont "))")
	 ((next-cont 1)))))

(define-macro (s-repeat count exp1 . exps)
   (let ((repeat-count (gensym))
	 (repeat-loop (gensym))
	 (orig-count (gensym)))
      (print "(s-repeat (gensyms (repeat-count " repeat-count ")(repeat-loop " repeat-loop ")))")
      (flush-output-port (current-output-port))
      `(let ,repeat-loop ((,repeat-count ,count)(,orig-count ,count))
	    (print "(s-repeat (repeat-count " ,repeat-count ")(orig-count " ,orig-count "))")
	    (flush-output-port (current-output-port))
	    (cond ((= 0 ,repeat-count) #t)
		  (else
		   ,exp1
		   ,@exps
		   (,repeat-loop (- ,repeat-count 1) ,orig-count))))))

(define (s-add-client . args)
   (apply s-add-task args))

(define (function-that-yields arg)
   (print "(function-that-yields)")
   ; this calls into a large C++ library
   (let ((a (list 3 4 5)))
      (print "((a " a ")(arg " arg "))"))
   (s-yield))

(define (main args)
   (loadq "corrupted-let-interpreted.scm")
   (eval `(user-main 1))
   (s-go))

Reply via email to