bugScheme Untergrund Library - Bugs: bug #15920, Two CML bugs, with fixes


bug #15920: Two CML bugs, with fixes

Submitted by:  None
Submitted on:  Mon 27 Feb 2006 07:08:01 PM UTC  
Category:  None Severity:  3 - Normal
Item Group:  None Status:  None
Privacy:  Public Assigned to:  None
Open/Closed:  Open

Add a New Comment(Rich Markup)

You are not logged in

Please log in, so followups can be emailed to you.


Tue 28 Feb 2006 03:17:06 PM UTC, comment #1:

Rather than making never-rv be a read on a channel, Reppy recommends
changing the routine SYNC-GROUP to be like so:

(define (sync-group group)
(lambda () (collect-group group))

That is simpler, and doesn't require changing the structures in CML's
package file. He says that's how it will be in SML/NJ 110.58.

Mon 27 Feb 2006 07:08:01 PM UTC, original submission:

Here's a structure that shows some bugs in the CML implementation, and a diff showing my fixes.

One bug is that a nack on never doesn't get activated. The other is that a cvar gets set twice.

To fix the never-rv bug, Reppy recommended a workaround that required changing the structures in CML -- I merged the channels in with the events, so that never-rv is just a receive on a channel with no sender.

Fixing the cvar-set-twice bug requires that the cvar-setting code pay attention to disabled transids.

(define-structure cml-bug (export hangs ignore-cancelled-cvars-bug)
(open rendezvous rendezvous-channels threads scheme-with-scsh)
;; Sync-group is broken; if COLLECT only returns a list of one
;; element (as for the first select below, due to NEVER-RV's
;; result being trivial), then SYNC-GROUP calls a routine that
;; will not set the cvar of the nack, so the main thread blocks.
;; Reppy confirmed that it should not hang.
(define (hangs)
(let ((c (make-channel)))
(spawn (lambda ()
(select (always-rv 1)
(with-nack (lambda (nack)
(send c nack)
(for-each display '("If you don't see DONE, I'm stuck." #\newline))
(select (receive c))
(for-each display '("DONE!" #\newline))))

;; The set-the-cvar routine doesn't ignore cancelled
;; trans-ids. That can lead to problems, as this one illustrates.
(define (ignore-cancelled-cvars-bug)
(for-each display '("If you get \"Error: cvar already set\", there's a problem." #\newline))
(let ((c (make-channel))
;; in case you have that first bug, this will allow it to
;; work.
(never-event (lambda () (receive-rv (make-channel)))))
(spawn (lambda ()
(select (always-rv 1)
(with-nack (lambda (nack)
(send c nack)
(with-nack (lambda (nack)
(send c nack)
(select (with-nack (lambda (nack) (never-rv))) ; need this to get the bug.
(receive c)
(receive c))
(for-each display '("OK, finishing." #\newline))))))

diff -r cml_orig cml
diff cml_orig/channel.scm cml/channel.scm

> ;; Reppy's recommended workaround is:
> ;; val never = let val ch : unit chan = channel() in recvEvt ch end
> ;;
> (define never-rv (receive-rv (make-channel)))
> (define (never-rv)
> never-rv)

diff cml_orig/packages.scm cml/packages.scm
< (make-rendezvous make-rendezvous-interface))

> (make-rendezvous make-rendezvous-interface)
> (rendezvous-channels rendezvous-channels-interface))

< (subset util (unspecific)))
< (files rendezvous))

> (subset util (unspecific))
> queues)
> (files rendezvous channel))

< (define-structure rendezvous-channels rendezvous-channels-interface
< (open scheme
< srfi-9
< trans-ids rendezvous make-rendezvous
< queues
< big-util
< (subset util (unspecific)))
< (files channel))

> ;(define-structure rendezvous-channels rendezvous-channels-interface
> ; (open scheme
> ; srfi-9
> ; trans-ids rendezvous make-rendezvous
> ; queues
> ; big-util
> ; (subset util (unspecific)))
> ; (files channel))

diff cml_orig/rendezvous.scm cml/rendezvous.scm
< ((cvar-item-cleanup-thunk cvar-item))

> (if (not (trans-id-cancelled? (cvar-item-trans-id cvar-item)))
> ((cvar-item-cleanup-thunk cvar-item)))

< (define (never-rv)
< (really-make-base '()))

> ; Please see channel.scm for the workaround.
> ;(define (never-rv)
> ; (really-make-base '()))



(Note: upload size limit is set to 16384 kB, after insertion of the required escape characters.)

Attach Files:

No files currently attached


Depends on the following items: None found

Items that depend on this one: None found


CC list is empty


Do you think this task is very important?
If so, you can add your encouragement to it.
This task has 0 encouragements so far.

Only logged-in users can vote.




No changes have been made to this item

Back to the top

Powered by Savane 3.3