Changeset 34364 in project


Ignore:
Timestamp:
08/25/17 20:32:34 (4 weeks ago)
Author:
kon
Message:

we may need this - cond-ex is better

Location:
release/4/mailbox
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/mailbox/tags/2.2.2/mailbox.scm

    r34362 r34364  
    307307    ;Timeout wanted so sleep until something happens
    308308    (timout
    309       (cond
    310         ((thread-sleep/maybe-unblock! timout UNBLOCKED-TAG)
    311           ;Timed-out, so no message
    312           ;Remove from wait queue
    313           (%mailbox-waiters-delete! mb ($current-thread))
    314           ;Indicate no available message
    315           (timeout-exit!) )
     309      (cond-expand
     310        (sleep-primordial-thread
     311          (cond
     312            ((thread-sleep/maybe-unblock! timout UNBLOCKED-TAG)
     313              ;Timed-out, so no message
     314              ;Remove from wait queue
     315              (%mailbox-waiters-delete! mb ($current-thread))
     316              ;Indicate no available message
     317              (timeout-exit!) )
     318            (else
     319              ;Unblocked early
     320              UNBLOCKED-TAG ) ) )
    316321        (else
    317           ;Unblocked early
    318           UNBLOCKED-TAG ) )
    319       #; ;NOT YET
    320       (if (eq? ($current-thread) ##sys#primordial-thread)
    321         (begin
    322           (warning "mailbox attempt to sleep primordial-thread" mb)
    323           (timeout-exit!) )
    324         (cond
    325           ((thread-sleep/maybe-unblock! timout UNBLOCKED-TAG)
    326             ;Timed-out, so no message
    327             ;Remove from wait queue
    328             (%mailbox-waiters-delete! mb ($current-thread))
    329             ;Indicate no available message
    330             (timeout-exit!) )
    331           (else
    332             ;Unblocked early
    333             UNBLOCKED-TAG ) ) ) )
     322          (if (eq? ($current-thread) ##sys#primordial-thread)
     323            (begin
     324              (warning "mailbox attempt to sleep primordial-thread" mb)
     325              (timeout-exit!) )
     326            (cond
     327              ((thread-sleep/maybe-unblock! timout UNBLOCKED-TAG)
     328                ;Timed-out, so no message
     329                ;Remove from wait queue
     330                (%mailbox-waiters-delete! mb ($current-thread))
     331                ;Indicate no available message
     332                (timeout-exit!) )
     333              (else
     334                ;Unblocked early
     335                UNBLOCKED-TAG ) ) ) ) ) )
    334336    ;No timeout so suspend until something delivered
    335337    (else
  • release/4/mailbox/tags/2.2.2/mailbox.setup

    r34362 r34364  
    99    -scrutinize
    1010    -feature unsafe-operations
     11    -feature sleep-primordial-thread
    1112    -optimize-level 3 -debug-level 1
    1213    -no-procedure-checks -no-bound-checks -no-argc-checks))
  • release/4/mailbox/trunk/mailbox.scm

    r34361 r34364  
    307307    ;Timeout wanted so sleep until something happens
    308308    (timout
    309       (cond
    310         ((thread-sleep/maybe-unblock! timout UNBLOCKED-TAG)
    311           ;Timed-out, so no message
    312           ;Remove from wait queue
    313           (%mailbox-waiters-delete! mb ($current-thread))
    314           ;Indicate no available message
    315           (timeout-exit!) )
     309      (cond-expand
     310        (sleep-primordial-thread
     311          (cond
     312            ((thread-sleep/maybe-unblock! timout UNBLOCKED-TAG)
     313              ;Timed-out, so no message
     314              ;Remove from wait queue
     315              (%mailbox-waiters-delete! mb ($current-thread))
     316              ;Indicate no available message
     317              (timeout-exit!) )
     318            (else
     319              ;Unblocked early
     320              UNBLOCKED-TAG ) ) )
    316321        (else
    317           ;Unblocked early
    318           UNBLOCKED-TAG ) )
    319       #; ;NOT YET
    320       (if (eq? ($current-thread) ##sys#primordial-thread)
    321         (begin
    322           (warning "mailbox attempt to sleep primordial-thread" mb)
    323           (timeout-exit!) )
    324         (cond
    325           ((thread-sleep/maybe-unblock! timout UNBLOCKED-TAG)
    326             ;Timed-out, so no message
    327             ;Remove from wait queue
    328             (%mailbox-waiters-delete! mb ($current-thread))
    329             ;Indicate no available message
    330             (timeout-exit!) )
    331           (else
    332             ;Unblocked early
    333             UNBLOCKED-TAG ) ) ) )
     322          (if (eq? ($current-thread) ##sys#primordial-thread)
     323            (begin
     324              (warning "mailbox attempt to sleep primordial-thread" mb)
     325              (timeout-exit!) )
     326            (cond
     327              ((thread-sleep/maybe-unblock! timout UNBLOCKED-TAG)
     328                ;Timed-out, so no message
     329                ;Remove from wait queue
     330                (%mailbox-waiters-delete! mb ($current-thread))
     331                ;Indicate no available message
     332                (timeout-exit!) )
     333              (else
     334                ;Unblocked early
     335                UNBLOCKED-TAG ) ) ) ) ) )
    334336    ;No timeout so suspend until something delivered
    335337    (else
  • release/4/mailbox/trunk/mailbox.setup

    r34353 r34364  
    99    -scrutinize
    1010    -feature unsafe-operations
     11    -feature sleep-primordial-thread
    1112    -optimize-level 3 -debug-level 1
    1213    -no-procedure-checks -no-bound-checks -no-argc-checks))
Note: See TracChangeset for help on using the changeset viewer.