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)
  (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 Files:
   
   
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 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.4