bugs in queue operations

Several queue operations have optimistic concurrency bugs because they
don't use provisional readers and writers.  For example, if you call
QUEUE-LENGTH twice in a single transaction without performing any
destructive operations on the queue in the meantime, it should, but
doesn't, return the same answer both times, whether or not other
threads have committed changes to the queue.  The problem is that
QUEUE-LENGTH uses the non-provisional LENGTH.  At the end of this
message is a program demonstrating this bug.

<http://mumble.net/~campbell/darcs/scheme-cml/s48-optimistic-queue.scm>
contains an alternative implementation of queues that, as far as I am
aware, presents a consistent state of each queue within a single
transaction.  The code is simpler, too: it uses a simpler structure
for queues, with fewer sites and kinds of mutation, to enable easier
reasoning about its correctness.  This does not change the asymptotic
running times or space usage of any of the operations, however.

; With a count of 100000, this quickly signals an error for me using
; Scheme48's built-in QUEUES structure, but not using my code.

; ,open queues proposals threads

(define (test count)
  (let ((queue (make-queue)) (go? #t))
    (spawn (lambda ()
             (let loop ((i 0))
               (if (< i count)
                   (begin
                     ;; Don't blow the heap by enqueueing too much
                     ;; before the dequeuer runs.
                     (if (zero? (modulo i 1000))
                         (relinquish-timeslice))
                     (enqueue! queue i)
                     (loop (+ i 1))))))
           'enqueuer)
    (spawn (lambda ()
             (let loop ((i 0))
               ;; Using MAYBE-DEQUEUE! triggers the same bug.
               ;; (cond ((maybe-dequeue! queue)
               ;;        => (lambda (element)
               ;;             (if (not (= element i))
               ;;                 (error "Out of order:" i element))
               ;;             (loop (+ i 1))))
               ;;       ((< i count)
               ;;        (relinquish-timeslice)
               ;;        (loop i))
               ;;       (else
               ;;        (set! go? #f)))
               (if (queue-empty? queue)
                   (if (< i count)
                       (begin (relinquish-timeslice)
                              (loop i))
                       (set! go? #f))
                   (begin
                     (let* ((h (queue-head queue))
                            (i* (dequeue! queue)))
                       (if (not (= i* i h))
                           (error "Out of order:" i h i*)))
                     (loop (+ i 1))))))
           'dequeuer)
    (let loop ()
      (call-ensuring-atomicity!
        (lambda ()
          (let ((first-length (queue-length queue)))
            (relinquish-timeslice)
            (let ((second-length (queue-length queue)))
              (if (not (= first-length second-length))
                  (error "Length disagreement:"
                         first-length
                         second-length))))))
      (if go? (loop)))))