Changeset 34568 in project


Ignore:
Timestamp:
09/17/17 20:09:14 (3 months ago)
Author:
kon
Message:

accewss

Location:
release/4/thread-utils/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/thread-utils/trunk/tests/run.scm

    r34563 r34568  
    3030        thread-block-timeout
    3131        thread-state-buffer
     32        ;thread-name
    3233        ;thread-end-exception
    3334        thread-owned-mutexes
     35        ;thread-quantum
     36        ;thread-specific
    3437        thread-block-object
    3538        thread-recipients
  • release/4/thread-utils/trunk/thread-utils.scm

    r34563 r34568  
    3232  thread-obstructed?
    3333  ;
    34   thread-blocked?/termination
    35   thread-blocked?/io
    36   thread-blocked?/timeout
     34  thread-blocked-with-termination?
     35  thread-blocked-with-io?
     36  thread-blocked-with-timeout?
    3737  ;
    3838  thread-unblock!
     
    7070  *thread-specific
    7171  *thread-block-object
    72   *thread-recipients )
     72  *thread-recipients
     73  ;
     74  ;DEPRECATED
     75  thread-blocked?/termination
     76  thread-blocked?/io
     77  thread-blocked?/timeout )
    7378
    7479(import scheme)
     
    123128    ((number? off)
    124129      (let (
    125           (base
    126             (cond
    127               ((number? base)
    128                 base )
    129               ((not base)
    130                 (time->seconds (current-time)) )
    131               ((time? base)
    132                 (time->seconds base) )
    133               (else
    134                 (error-thread-timeout 'make-thread-timeout base 'base) ) ) ) )
     130        (base
     131          (cond
     132            ((number? base)
     133              base )
     134            ((not base)
     135              (time->seconds (current-time)) )
     136            ((time? base)
     137              (time->seconds base) )
     138            (else
     139              (error-thread-timeout 'make-thread-timeout base 'base) ) ) ) )
    135140        (seconds->time (+ off base)) ) )
    136141    (else
    137142      (error-thread-timeout 'make-thread-timeout off 'offset) ) ) )
     143
     144;(define make-thread-timeout
    138145
    139146;;; Unchecked slot access
     
    255262;;
    256263
    257 (: thread-blocked?/object ((struct thread) --> *))
    258 (define (*thread-blocked?/object th)
     264(: thread-blocked-with-object ((struct thread) --> *))?
     265(define (*thread-blocked-with-object th)?
    259266  (and
    260267    (thread-blocked? th)
    261268    (*thread-block-object th)) )
    262269
    263 (: thread-blocked?/termination ((struct thread) --> boolean))
    264 (define (thread-blocked?/termination th)
     270(: thread-blocked-with-termination ((struct thread) --> boolean))?
     271(define (thread-blocked-with-termination th)?
    265272  (and
    266273    (thread-blocked? th)
     
    269276    #t ) )
    270277
    271 (: thread-blocked?/timeout ((struct thread) --> boolean))
    272 (define (thread-blocked?/timeout th)
     278(: thread-blocked-with-timeout ((struct thread) --> boolean))?
     279(define (thread-blocked-with-timeout th)?
    273280  (and
    274281    (thread-blocked? th)
     
    277284    #t ) )
    278285
    279 (: thread-blocked?/io ((struct thread) --> boolean))
    280 (define (thread-blocked?/io th)
    281   (and-let* ((obj (*thread-blocked?/object th)))
     286(: thread-blocked-with-io ((struct thread) --> boolean))?
     287(define (thread-blocked-with-io th)?
     288  (and-let* ((obj (*thread-blocked-with-object th)))?
    282289    ;FIXME should check for (fd . i/o)
    283290    (pair? obj) ) )
     
    292299(: thread-unblock! ((struct thread) -> void))
    293300(define (thread-unblock! th)
    294   (when (thread-blocked?/timeout th)
     301  (when (thread-blocked-with-timeout th)?
    295302    (##sys#thread-unblock! th) )
    296303  #;
     
    307314(: thread-thunk ((struct thread) --> procedure))
    308315(define (thread-thunk th)
    309         (check-thread 'thread-thunk th)
    310         (*thread-thunk th) )
     316        (*thread-thunk (check-thread 'thread-thunk th)) )
    311317
    312318(: thread-result-list ((struct thread) --> (or boolean list)))
    313319(define (thread-result-list th)
    314         (check-thread 'thread-result-list th)
    315         (*thread-result-list th) )
     320        (*thread-result-list (check-thread 'thread-result-list th)) )
    316321
    317322#;
     
    319324#;
    320325(define (thread-state th)
    321         (check-thread 'thread-state th)
    322         (*thread-state th) )
     326        (*thread-state (check-thread 'thread-state th)) )
    323327
    324328(: thread-block-timeout ((struct thread) --> (or boolean float)))
    325329(define (thread-block-timeout th)
    326         (check-thread 'thread-block-timeout th)
    327         (*thread-block-timeout th) )
     330        (*thread-block-timeout (check-thread 'thread-block-timeout th)) )
    328331
    329332(: thread-state-buffer ((struct thread) --> vector))
    330333(define (thread-state-buffer th)
    331         (check-thread 'thread-state-buffer th)
    332         (*thread-state-buffer th) )
     334        (*thread-state-buffer (check-thread 'thread-state-buffer th)) )
    333335
    334336#;
     
    336338#;
    337339(define (thread-name th)
    338         (check-thread 'thread-name th)
    339         (*thread-name th) )
     340        (*thread-name (check-thread 'thread-name th)) )
    340341
    341342(: thread-end-exception ((struct thread) --> *))
    342343(define (thread-end-exception th)
    343         (check-thread 'thread-end-exception th)
    344         (*thread-end-exception th) )
     344        (*thread-end-exception (check-thread 'thread-end-exception th)) )
    345345
    346346(: thread-owned-mutexes ((struct thread) --> list))
    347347(define (thread-owned-mutexes th)
    348         (check-thread 'thread-owned-mutexes th)
    349         (*thread-owned-mutexes th) )
     348        (*thread-owned-mutexes (check-thread 'thread-owned-mutexes th)) )
    350349
    351350#;
     
    353352#;
    354353(define (thread-quantum th)
    355         (check-thread 'thread-quantum th)
    356         (*thread-quantum th) )
     354        (*thread-quantum (check-thread 'thread-quantum th)) )
    357355
    358356#;
     
    360358#;
    361359(define (thread-specific th)
    362         (check-thread 'thread-specific th)
    363         (*thread-specific th) )
     360        (*thread-specific (check-thread 'thread-specific th)) )
    364361
    365362(: thread-block-object ((struct thread) --> *))
    366363(define (thread-block-object th)
    367         (check-thread 'thread-block-object th)
    368         (*thread-block-object th) )
     364        (*thread-block-object (check-thread 'thread-block-object th)) )
    369365
    370366(: thread-recipients ((struct thread) --> list))
    371367(define (thread-recipients th)
    372         (check-thread 'thread-recipients th)
    373         (*thread-recipients th) )
     368        (*thread-recipients (check-thread 'thread-recipients th)) )
    374369
    375370(: unblocked-by-timeout? ((struct thread) --> boolean))
    376371(define (unblocked-by-timeout? th)
    377         (check-thread 'unblocked-by-timeout? th)
    378         (*unblocked-by-timeout? th) )
    379 
    380 ;;
    381 
    382 (: thread-dynamic-winds (thread --> list))
     372        (*unblocked-by-timeout? (check-thread 'unblocked-by-timeout? th)) )
     373
     374;;
     375
     376(: thread-dynamic-winds ((struct thread) --> list))
    383377(define (thread-dynamic-winds th)
    384         (check-thread 'thread-dynamic-winds th)
    385         (*state-buffer-dynamic-winds (*thread-state-buffer th)) )
    386 
    387 (: thread-standard-input (thread --> port))
     378        (*state-buffer-dynamic-winds (*thread-state-buffer (check-thread 'thread-dynamic-winds th))) )
     379
     380(: thread-standard-input ((struct thread) --> port))
    388381(define (thread-standard-input th)
    389         (check-thread 'thread-standard-input th)
    390         (*state-buffer-standard-input (*thread-state-buffer th)) )
    391 
    392 (: thread-standard-output (thread --> port))
     382        (*state-buffer-standard-input (*thread-state-buffer (check-thread 'thread-standard-input th))) )
     383
     384(: thread-standard-output ((struct thread) --> port))
    393385(define (thread-standard-output th)
    394         (check-thread 'thread-standard-output th)
    395         (*state-buffer-standard-output (*thread-state-buffer th)) )
    396 
    397 (: thread-standard-error (thread --> port))
     386        (*state-buffer-standard-output (*thread-state-buffer (check-thread 'thread-standard-output th))) )
     387
     388(: thread-standard-error ((struct thread) --> port))
    398389(define (thread-standard-error th)
    399         (check-thread 'thread-standard-error th)
    400         (*state-buffer-standard-error (*thread-state-buffer th)) )
    401 
    402 (: thread-default-exception-handler (thread --> procedure))
     390        (*state-buffer-standard-error (*thread-state-buffer (check-thread 'thread-standard-error th))) )
     391
     392(: thread-default-exception-handler ((struct thread) --> procedure))
    403393(define (thread-default-exception-handler th)
    404         (check-thread 'thread-default-exception-handler th)
    405         (*state-buffer-default-exception-handler (*thread-state-buffer th)) )
    406 
    407 (: thread-current-parameter-vector (thread --> vector))
     394        (*state-buffer-default-exception-handler (*thread-state-buffer (check-thread 'thread-default-exception-handler th))) )
     395
     396(: thread-current-parameter-vector ((struct thread) --> vector))
    408397(define (thread-current-parameter-vector th)
    409         (check-thread 'thread-current-parameter-vector th)
     398        (*state-buffer-current-parameter-vector (*thread-state-buffer (check-thread 'thread-current-parameter-vector th))) )
     399
     400#; ;TBD
     401(:define vector (thread-current-parameter-vector ((struct thread) th) !..)
     402        ;# ;
     403        "..."
     404        ;# ;dynamic checks
     405        (check-thread 'thread-current-parameter-vector th) ...
     406        ...
     407        ;body
    410408        (*state-buffer-current-parameter-vector (*thread-state-buffer th)) )
    411409
     410;DEPRECATED
     411
     412(define thread-blocked?/termination thread-blocked-with-termination?)
     413(define thread-blocked?/io thread-blocked-with-io?)
     414(define thread-blocked?/timeout thread-blocked-with-timeout?)
     415
    412416) ;module thread-utils
Note: See TracChangeset for help on using the changeset viewer.