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: NoneSeverity: 3 - Normal
Item Group: NoneStatus: None
Privacy: PublicAssigned to: None
Open/Closed: Open

Add a New Comment (Rich MarkupRich 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)
(call-with-values
(lambda () (collect-group group))
really-sync-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.

Anonymous
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)
(begin
;; 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)
(never-rv))))))
(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)
(never-event)))
(with-nack (lambda (nack)
(send c nack)
(never-event))))))
(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
100a101,107

>
> ;; 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
53c53,54
< (make-rendezvous make-rendezvous-interface))
---

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

59,60c60,62
< (subset util (unspecific)))
< (files rendezvous))
---

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

62,69c64,71
< (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
88c88,89
< ((cvar-item-cleanup-thunk cvar-item))
---

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

124,125c125,127
< (define (never-rv)
< (really-make-base '()))
---

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

Anonymous

 

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

Attach File(s):
   
   
Comment:
   

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 click here to add your encouragement to it.
This task has 0 encouragements so far.

Only logged-in users can vote.

 

Please enter the title of George Orwell's famous dystopian book (it's a date):

 

 

No Changes Have Been Made to This Item

Back to the top


Powered by Savane 3.1-cleanup