Changeset 37282 in project


Ignore:
Timestamp:
02/23/19 18:05:10 (4 weeks ago)
Author:
kon
Message:

close open

Location:
release/5/mailbox/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/mailbox/trunk/inline-queue.scm

    r36562 r37282  
    5656  (let scanning ((this-pair (%queue-first-pair q)) (prev-pair '()))
    5757    ;keep scanning until found
    58     (if (not ($eq? this-pair targ-pair))
     58    (cond
     59      ;should not happen but no infinite loops
     60      ((null? this-pair)
     61        ;note that the pair to extract is in fact gone so ...
     62        (warning "cannot find queue pair to extract; simultaneous operations?"))
     63      ;found?
     64      (($eq? this-pair targ-pair)
     65        ;so cut out the pair
     66        (let ((next-pair ($cdr this-pair)))
     67          ;at the head of the list, or in the body?
     68          (if ($null? prev-pair)
     69            (%queue-first-pair-set! q next-pair)
     70            ($set-cdr! prev-pair next-pair) )
     71          ;when the cut pair is the last item update the last pair ref.
     72          (when ($eq? this-pair (%queue-last-pair q))
     73            (%queue-last-pair-set! q prev-pair)) ) )
    5974      ;not found
    60       (scanning ($cdr this-pair) this-pair)
    61       ;found so cut out the pair
    62       (let ((next-pair ($cdr this-pair)))
    63         ;at the head of the list, or in the body?
    64         (if ($null? prev-pair)
    65           (%queue-first-pair-set! q next-pair)
    66           ($set-cdr! prev-pair next-pair) )
    67         ;when the cut pair is the last item update the last pair ref.
    68         (when ($eq? this-pair (%queue-last-pair q)) (%queue-last-pair-set! q prev-pair)) ) ) ) )
     75      (else
     76        (scanning ($cdr this-pair) this-pair) ) ) ) )
  • release/5/mailbox/trunk/mailbox.egg

    r36707 r37282  
    44((synopsis "Thread-safe queues with timeout")
    55 (category hell)
    6  (version "3.3.1")
     6 (version "3.3.2")
    77 (author "[[felix winkelman]] and [[kon lovett]]")
    88 (license "BSD")
  • release/5/mailbox/trunk/mailbox.scm

    r36707 r37282  
    600600  (ready-mailbox-thread! mb) )
    601601
     602;; Read/Print Syntax
     603
     604(define-record-printer (mailbox mb out)
     605  (with-output-to-port out
     606    (lambda ()
     607      (printf "#<mailbox ~A queued: ~A waiters: ~A>"
     608        (%mailbox-name mb)
     609        (%mailbox-queue-count mb)
     610        (%mailbox-waiters-count mb)) ) ) )
     611
    602612;;; Mailbox Cursor
    603613
     
    673683  (%mailbox-cursor-rewind! mbc) )
    674684
    675 ;;; Read/Print Syntax
    676 
    677 (define-record-printer (mailbox mb out)
    678   (with-output-to-port out
    679     (lambda ()
    680       (printf "#<mailbox ~A queued: ~A waiters: ~A>"
    681         (%mailbox-name mb)
    682         (%mailbox-queue-count mb)
    683         (%mailbox-waiters-count mb)) ) ) )
     685;; Read/Print Syntax
    684686
    685687(define-record-printer (mailbox-cursor mbc out)
Note: See TracChangeset for help on using the changeset viewer.