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


bug #15920: Two CML bugs, with fixes

Submitter:  None
Submitted:  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
* Mandatory Fields

Add a New Comment (Rich Markup)

Comment Type & Canned Response:


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


There are 0 votes so far. Votes easily highlight which items people would like to see resolved in priority, independently of the priority of the item set by tracker managers.

Only logged-in users can vote.





No changes have been made to this item

Back to the top

Powered by Savane 3.9