problem with continuations and corrupted data
"Dukes, Todd" <[email protected]>
| Newsgroups | gmane.lisp.scheme.bigloo |
|---|---|
| Message-ID | <[email protected]> |
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.
corrupted-let-interpreted.scm
(text/x-scheme, 588 B)
(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."))
corrupted-let-problem-example.scm
(text/x-scheme, 2.6 KB)
; 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))