Compile with command line at top of corrupted-let-problem-example.scm
Run with no arguments. My output looks like this:
bash-4.2$ ./corrupted-let-problem-example
(user-main 1)
p0 5
(p0:(s-ADD ((addr-mode disp) (dst (reg AL)) (src (disp 8192)))))
p1 3.(ebx ((23 34)))
(p1:(s-ADD ((addr-mode disp) (dst (reg AL)) (src (disp 13568)))))
(s-go (thread-exit-length 2))
p0 7
p0 8
(p0:(s-ADD ((addr-mode reg-imm) (dst (reg BX)) (src (imm 0)))))
p1 4.(ebx 165)
(s-go (thread-exit-length 1))
p0 9
(s-go (thread-exit-length 0))
bash-4.2$
The line 'p1 4.(ebx 165)' is incorrect. The value of ebx has taken on the value
passed to the check-mem function on line 20 of correupted-let-interpreted.scm
This can be verified by changing the value and running again. When I did this,
I saw the output change to match.
Let me know if you cannot reproduce or if I am misunderstanding how
continuations should work.
Thanks,
Todd D.
________________________________
(define (user-main arg)
(s-ui-trace-level-set! 1)
(print "(user-main " arg ")")
(s-add-client task0 "p0")
(s-add-client task1 "p1"))
(define (check-mem addr data size)
#t)
(define (check-regs arg)
#t)
(define (add-zero-bias-layer)
(s-bias-push '((int-src-random 0))))
(define (task0 x)
(V1 "p0 5")
(s-ADD '((addr-mode disp) (dst (reg AL)) (src (disp #x2000))))
(check-mem #x2000 102 1)
(V1 "p0 7")
(check-regs '((EAX #x4A)(RFLAGS #x803)))
(V1 "p0 8")
(s-ADD '((addr-mode reg-imm) (dst (reg BX)) (src (imm #x0))))
(V1 "p0 9"))
(define (task1 x)
(let ((ebx (s-register-index "EBX")))
(V1 "p1 3.(ebx " ebx ")")
(s-ADD '((addr-mode disp) (dst (reg AL)) (src (disp #x3500))))
(V1 "p1 4.(ebx " ebx ")")))
(define-macro (V1 exp1 . exps)
`(begin
(when (s-ui-trace-predicate 0)
(print ,exp1 ,@exps)
(flush-output-port (current-output-port)))
#f))
; 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)
(s-bias-push #!key name #!rest arg)
(s-bias-set arg)
(s-info args)
(s-ui-trace-predicate bit)
(s-ADD arg)
(s-register-index name)
(s-ui-trace-level-set! level)
(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-ADD arg)
(let ((thread-data (s-thread-data)))
(print "(" thread-data ":(s-ADD " arg "))"))
(s-yield))
(define (s-info arg)
#t)
(define (s-bias-push #!key name #!rest arg)
#t)
(define (s-register-index name)
; this actually returns a foriegn
(list '(23 34)))
(define (s-bias-set arg)
#t)
(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 *ui-trace-level* 0)
(define (s-ui-trace-predicate bit)
(let ((rv (not (= (bit-and *ui-trace-level* (bit-lsh 1 bit)) 0))))
;(print "((*ui-trace-level* " *ui-trace-level* " )((and tl 1) " rv "))")
rv))
(define (s-ui-trace-level-get)
*ui-trace-level*)
(define (s-ui-trace-level-set! trace-level)
;(print "(s-set-ui-trace-level " trace-level ")")
(set! *ui-trace-level* trace-level)
*ui-trace-level*)
(define-macro (V1 exp1 . exps)
`(begin
(when (s-ui-trace-predicate 0)
(print ,exp1 ,@exps)
(flush-output-port (current-output-port)))
#f))
(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-macros.scm")
(loadq "corrupted-let-interpreted.scm")
(eval `(user-main 1))
(s-go))
