Failing example: RE: problem with continuations and corrupted data

"Dukes, Todd" <[email protected]> Tue, 5 Aug 2014 00:37:16 +0000

Newsgroups	gmane.lisp.scheme.bigloo
Message-ID	<[email protected]>

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.



________________________________

corrupted-let-interpreted.scm (text/x-scheme, 787 B)

(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 ")")))

corrupted-let-macros.scm (text/x-scheme, 164 B)

(define-macro (V1 exp1 . exps)
   `(begin
       (when (s-ui-trace-predicate 0)
	   (print ,exp1 ,@exps)
	   (flush-output-port (current-output-port)))
       #f))

corrupted-let-problem-example.scm (text/x-scheme, 3.7 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)
      (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))