Changeset 39746 in project


Ignore:
Timestamp:
03/19/21 20:00:55 (5 weeks ago)
Author:
Kon Lovett
Message:

add read/write wait!, add limited cursor index inc!/dec!, cursor test labeling

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

Legend:

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

    r39745 r39746  
    250250(define (queue-limited-cursor-index-set! c v) (set-car! c v))
    251251
     252(define (queue-limited-cursor-index-inc! q c)
     253  (queue-limited-cursor-index-set! c
     254    (queue-limited-index-inc q (queue-limited-cursor-index c))) )
     255
     256(define (queue-limited-cursor-index-dec! q c)
     257  (queue-limited-cursor-index-set! c
     258    (queue-limited-index-dec q (queue-limited-cursor-index c))) )
     259
    252260(define (queue-limited-cursor-winding? q c)
    253261  (fx<= 0 (queue-limited-cursor-index c)) )
     
    264272    (else
    265273      (let ((v (queue-limited-peek q (queue-limited-cursor-index c))))
    266         (queue-limited-cursor-index-set! c
    267           (queue-limited-index-inc q (queue-limited-cursor-index c)))
     274        (queue-limited-cursor-index-inc! q c)
    268275        v ) ) ) )
    269276
    270277(define (queue-limited-cursor-continue! q c)
    271   (queue-limited-cursor-index-set! c
    272     (queue-limited-index-dec q (queue-limited-cursor-index c))) )
     278  (queue-limited-cursor-index-dec! q c) )
    273279
    274280(define (queue-limited-cursor-rewind! q c)
  • release/5/mailbox/trunk/mailbox.scm

    r39745 r39746  
    5252  mailbox-write-waiters
    5353  mailbox-send!
    54   mailbox-wait!
     54  mailbox-read-wait!
     55  mailbox-write-wait!
    5556  mailbox-receive!
    5657  mailbox-push-back!
     
    6768  ;deprecated
    6869  mailbox-waiting?
    69   mailbox-waiters)
     70  mailbox-waiters
     71  mailbox-wait!)
    7072
    7173(import scheme
     
    113115
    114116(: mailbox-send!                      (mailbox * -> void))
    115 (: mailbox-wait!                      (mailbox #!optional timeout -> void))
     117(: mailbox-read-wait!                 (mailbox #!optional timeout -> void))
     118(: mailbox-write-wait!                (mailbox #!optional timeout -> void))
     119(: mailbox-wait!                      (deprecated mailbox-write-wait!))
    116120(: mailbox-receive!                   (mailbox #!optional timeout * -> *))
    117121(: mailbox-push-back!                 (mailbox * -> void))
     
    653657    (ready-mailbox-reader! mb) ) )
    654658
    655 (define (mailbox-wait! mb #!optional timout)
    656   (when timout (%check-timeout 'mailbox-wait! timout))
    657   (wait-mailbox-write! 'mailbox-wait!
     659(define (mailbox-read-wait! mb #!optional timout)
     660  (when timout (%check-timeout 'mailbox-read-wait! timout))
     661  (wait-mailbox-read! 'mailbox-read-wait!
    658662    ;wait until
    659     (%check-mailbox 'mailbox-wait! mb) 0 timout NO-TOVAL-TAG
     663    (%check-mailbox 'mailbox-read-wait! mb) 0 timout NO-TOVAL-TAG
    660664    ;then
    661665    (void) ) )
     666
     667(define (mailbox-write-wait! mb #!optional timout)
     668  (when timout (%check-timeout 'mailbox-write-wait! timout))
     669  (wait-mailbox-write! 'mailbox-write-wait!
     670    ;wait until
     671    (%check-mailbox 'mailbox-write-wait! mb) 0 timout NO-TOVAL-TAG
     672    ;then
     673    (void) ) )
     674
     675(define mailbox-wait! mailbox-write-wait!)
    662676
    663677(define (mailbox-receive! mb #!optional timout (timout-value NO-TOVAL-TAG))
  • release/5/mailbox/trunk/tests/mailbox-cursor-test.scm

    r39743 r39746  
    4545
    4646  (define (writer-thread-body)
    47     (thread-labeled-print "Started!")
     47    (define (send-it msg)
     48      (thread-labeled-print "Send " msg " at " (current-seconds) " sec")
     49      (mailbox-send! mb1 msg) )
     50    (thread-labeled-print "Started")
    4851    (let loop ((cnt 0))
     52      ;#; ;FIXME w/o even unlimited deadlocks!
    4953      (thread-sleep! tmo)
    5054      (if (= lmt cnt)
     55        (send-it (makmsg 'quit))
    5156        (begin
    52           (thread-labeled-print "Send! Quit at " (current-seconds) " sec")
    53           (mailbox-send! mb1 (makmsg 'quit)) )
    54         (let ((msg (makmsg cnt)))
    55           (thread-labeled-print "Send! at " (current-seconds) " sec")
    56           (mailbox-send! mb1 msg)
     57          (send-it (makmsg cnt))
    5758          (loop (add1 cnt))) ) ) )
    5859
     
    6364        (let loop ()
    6465          (let ((msg (mailbox-cursor-next mbc)))
    65             (thread-labeled-print "Receive! at " (current-seconds)  " sec")
     66            (thread-labeled-print "Next at " (current-seconds)  " sec")
     67            ;FIXME must process msgs in FIFO order, not LIFO order
    6668            (if (eq? 'quit (msgval msg))
    67               (thread-labeled-print "Test Quit: " msg)
     69              (begin
     70                (thread-labeled-print "Quit - Removing: " msg)
     71                (mailbox-cursor-extract-and-rewind! mbc) )
    6872              (begin
    6973                (when (test msg)
    70                   (thread-labeled-print "Test Match - Removing Message: " msg)
     74                  (thread-labeled-print "Match - Removing: " msg)
    7175                  (mailbox-cursor-extract-and-rewind! mbc) )
    7276                (loop) ) ) ) ) ) ) )
Note: See TracChangeset for help on using the changeset viewer.