Changeset 35444 in project


Ignore:
Timestamp:
04/26/18 03:52:36 (5 weeks ago)
Author:
kon
Message:

re-flow, use ->boolean, thread is pre-defined type

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

Legend:

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

    r35013 r35444  
    4848  (only type-checks
    4949    check-positive-number check-natural-fixnum))
     50
     51;;
     52
     53(define (->boolean x)
     54  (and x #t) )
    5055
    5156;;
     
    201206(define (thread-reaper-stop!)
    202207  (when (and +reaper-thread+ (not +stopping?+))
    203     (let ((th +reaper-thread+))
     208    (let (
     209      (th +reaper-thread+) )
    204210      ;Bump up the time-slice so queue clears faster
    205211      (thread-quantum-set! th (fxmax (thread-quantum th) STOPPING-REAPER-QUANTUM))
     
    215221  ;noreturn
    216222  (void) )
     223
    217224;;
    218225
     
    221228
    222229(define (thread-reaper-greedy-set! flag)
    223   (set! +greedy?+ (and flag #t)) )
     230  (set! +greedy?+ (->boolean flag)) )
    224231
    225232(define thread-reaper-greedy
  • release/4/thread-utils/trunk/thread-utils.scm

    r35425 r35444  
    7979(import scheme chicken)
    8080(use
     81  (only extras format)
     82  (only ports with-output-to-string)
    8183  (only srfi-1 any)
    8284  (only srfi-18
     
    9092
    9193(define (thread-warning-message th)
    92   (let ((o (open-output-string)))
    93     (display "Warning (" o)
    94     (display th o)
    95     (display "): " o)
    96     (get-output-string o) ) )
    97 
    98 (define (print-exception-error exn #!optional (th (current-thread)) (out (current-error-port)))
     94  (with-output-to-string (cut format #t "Warning (~A): " th)) )
     95
     96(define (print-exception-error exn
     97            #!optional (th (current-thread)) (out (current-error-port)))
    9998  (print-error-message exn out (thread-warning-message th))
    10099  (print-call-chain out 0 th) )
    101100
    102 (define (print-exception-warning exn #!optional (th (current-thread)) (out (current-error-port)))
     101(define (print-exception-warning exn
     102            #!optional (th (current-thread)) (out (current-error-port)))
    103103  (when (enable-warnings)
    104104    (print-exception-error exn th out)) )
     
    212212;;
    213213
    214 (: thread-state=? ((struct thread) * --> boolean))
     214(: thread-state=? (thread * --> boolean))
    215215;
    216216(define (thread-state=? th tk)
    217217        (eq? tk (thread-state th)) )
    218218
    219 (: thread-created? ((struct thread) --> boolean))
     219(: thread-created? (thread --> boolean))
    220220;
    221221(define (thread-created? th)
    222222        (thread-state=? th 'created) )
    223223
    224 (: thread-ready? ((struct thread) --> boolean))
     224(: thread-ready? (thread --> boolean))
    225225;
    226226(define (thread-ready? th)
    227227        (thread-state=? th 'ready) )
    228228
    229 (: thread-running? ((struct thread) --> boolean))
     229(: thread-running? (thread --> boolean))
    230230;
    231231(define (thread-running? th)
    232232        (thread-state=? th 'running) )
    233233
    234 (: thread-blocked? ((struct thread) --> boolean))
     234(: thread-blocked? (thread --> boolean))
    235235;
    236236(define (thread-blocked? th)
    237237        (thread-state=? th 'blocked) )
    238238
    239 (: thread-suspended? ((struct thread) --> boolean))
     239(: thread-suspended? (thread --> boolean))
    240240;
    241241(define (thread-suspended? th)
    242242        (thread-state=? th 'suspended) )
    243243
    244 (: thread-sleeping? ((struct thread) --> boolean))
     244(: thread-sleeping? (thread --> boolean))
    245245;
    246246(define (thread-sleeping? th)
    247247        (thread-state=? th 'sleeping) )
    248248
    249 (: thread-terminated? ((struct thread) --> boolean))
     249(: thread-terminated? (thread --> boolean))
    250250;
    251251(define (thread-terminated? th)
    252252        (thread-state=? th 'terminated) )
    253253
    254 (: thread-dead? ((struct thread) --> boolean))
     254(: thread-dead? (thread --> boolean))
    255255;
    256256(define (thread-dead? th)
    257257        (thread-state=? th 'dead) )
    258258
    259 (: thread-obstructed? ((struct thread) --> boolean))
     259(: thread-obstructed? (thread --> boolean))
    260260;
    261261(define (thread-obstructed? th)
     
    264264;;
    265265
    266 (: thread-blocked-for-object ((struct thread) --> *))
     266(: thread-blocked-for-object (thread --> *))
    267267;
    268268(define (*thread-blocked-for-object th)
     
    271271    (*thread-block-object th)) )
    272272
    273 (: thread-blocked-for-termination? ((struct thread) --> boolean))
     273(: thread-blocked-for-termination? (thread --> boolean))
    274274;
    275275(define (thread-blocked-for-termination? th)
     
    280280    #t ) )
    281281
    282 (: thread-blocked-for-timeout? ((struct thread) --> boolean))
     282(: thread-blocked-for-timeout? (thread --> boolean))
    283283;
    284284(define (thread-blocked-for-timeout? th)
     
    289289    #t ) )
    290290
    291 (: thread-blocked-for-io? ((struct thread) --> boolean))
     291(: thread-blocked-for-io? (thread --> boolean))
    292292;
    293293(define (thread-blocked-for-io? th)
     
    303303;;
    304304
    305 (: thread-unblock! ((struct thread) -> void))
     305(: thread-unblock! (thread -> void))
    306306;
    307307(define (thread-unblock! th)
     
    311311  (when (thread-obstructed? th)
    312312    (cond
    313       ((*thread-block-timeout th) (##sys#thread-unblock! th) )
     313      ((*thread-block-timeout th)
     314        (##sys#thread-unblock! th) )
    314315      ;cannot unblock when terminating
    315       ((*thread-recipients th)    )
     316      ((*thread-recipients th)
     317        )
    316318      ;cannot unblock when waiting for some other object
    317       ((*thread-block-object th)  ) ) ) )
    318 
    319 ;;
    320 
    321 (: thread-thunk ((struct thread) --> procedure))
     319      ((*thread-block-object th)
     320        ) ) ) )
     321
     322;;
     323
     324(: thread-thunk (thread --> procedure))
    322325;
    323326(define (thread-thunk th)
    324327        (*thread-thunk (check-thread 'thread-thunk th)) )
    325328
    326 (: thread-result-list ((struct thread) --> (or boolean list)))
     329(: thread-result-list (thread --> (or boolean list)))
    327330;
    328331(define (thread-result-list th)
    329332        (*thread-result-list (check-thread 'thread-result-list th)) )
    330333
    331 #;(: thread-state ((struct thread) --> *))
     334#;(: thread-state (thread --> *))
    332335;
    333336#;(define (thread-state th)
    334337        (*thread-state (check-thread 'thread-state th)) )
    335338
    336 (: thread-block-timeout ((struct thread) --> (or boolean float)))
    337 v(define (thread-block-timeout th)
     339(: thread-block-timeout (thread --> (or boolean float)))
     340(define (thread-block-timeout th)
    338341        (*thread-block-timeout (check-thread 'thread-block-timeout th)) )
    339342
    340 (: thread-state-buffer ((struct thread) --> vector))
     343(: thread-state-buffer (thread --> vector))
    341344;
    342345(define (thread-state-buffer th)
    343346        (*thread-state-buffer (check-thread 'thread-state-buffer th)) )
    344347
    345 #;(: thread-name ((struct thread) --> *))
     348#;(: thread-name (thread --> *))
    346349;
    347350#;(define (thread-name th)
    348351        (*thread-name (check-thread 'thread-name th)) )
    349352
    350 (: thread-end-exception ((struct thread) --> *))
     353(: thread-end-exception (thread --> *))
    351354;
    352355(define (thread-end-exception th)
    353356        (*thread-end-exception (check-thread 'thread-end-exception th)) )
    354357
    355 (: thread-owned-mutexes ((struct thread) --> list))
     358(: thread-owned-mutexes (thread --> list))
    356359;
    357360(define (thread-owned-mutexes th)
    358361        (*thread-owned-mutexes (check-thread 'thread-owned-mutexes th)) )
    359362
    360 #;(: thread-quantum ((struct thread) --> *))
     363#;(: thread-quantum (thread --> *))
    361364;
    362365#;(define (thread-quantum th)
    363366        (*thread-quantum (check-thread 'thread-quantum th)) )
    364367
    365 #;(: thread-specific ((struct thread) --> *))
     368#;(: thread-specific (thread --> *))
    366369;
    367370#;(define (thread-specific th)
    368371        (*thread-specific (check-thread 'thread-specific th)) )
    369372
    370 (: thread-block-object ((struct thread) --> *))
     373(: thread-block-object (thread --> *))
    371374;
    372375(define (thread-block-object th)
    373376        (*thread-block-object (check-thread 'thread-block-object th)) )
    374377
    375 (: thread-recipients ((struct thread) --> list))
     378(: thread-recipients (thread --> list))
    376379;
    377380(define (thread-recipients th)
    378381        (*thread-recipients (check-thread 'thread-recipients th)) )
    379382
    380 (: unblocked-by-timeout? ((struct thread) --> boolean))
     383(: unblocked-by-timeout? (thread --> boolean))
    381384;
    382385(define (unblocked-by-timeout? th)
     
    385388;;
    386389
    387 (: thread-dynamic-winds ((struct thread) --> list))
     390(: thread-dynamic-winds (thread --> list))
    388391;
    389392(define (thread-dynamic-winds th)
    390393        (*state-buffer-dynamic-winds (*thread-state-buffer (check-thread 'thread-dynamic-winds th))) )
    391394
    392 (: thread-standard-input ((struct thread) --> port))
     395(: thread-standard-input (thread --> port))
    393396;
    394397(define (thread-standard-input th)
    395398        (*state-buffer-standard-input (*thread-state-buffer (check-thread 'thread-standard-input th))) )
    396399
    397 (: thread-standard-output ((struct thread) --> port))
     400(: thread-standard-output (thread --> port))
    398401;
    399402(define (thread-standard-output th)
    400403        (*state-buffer-standard-output (*thread-state-buffer (check-thread 'thread-standard-output th))) )
    401404
    402 (: thread-standard-error ((struct thread) --> port))
     405(: thread-standard-error (thread --> port))
    403406;
    404407(define (thread-standard-error th)
    405408        (*state-buffer-standard-error (*thread-state-buffer (check-thread 'thread-standard-error th))) )
    406409
    407 (: thread-default-exception-handler ((struct thread) --> procedure))
     410(: thread-default-exception-handler (thread --> procedure))
    408411;
    409412(define (thread-default-exception-handler th)
    410413        (*state-buffer-default-exception-handler (*thread-state-buffer (check-thread 'thread-default-exception-handler th))) )
    411414
    412 (: thread-current-parameter-vector ((struct thread) --> vector))
     415(: thread-current-parameter-vector (thread --> vector))
    413416;
    414417(define (thread-current-parameter-vector th)
     
    416419
    417420#; ;TBD
    418 (:define vector (thread-current-parameter-vector ((struct thread) th) !..)
     421(:define vector (thread-current-parameter-vector (thread th) !..)
    419422        ;# ;
    420423        "..."
     
    427430;DEPRECATED
    428431
    429 (: thread-blocked?/termination deprecated)
     432(: thread-blocked?/termination (deprecated thread-blocked-for-termination?))
    430433(define thread-blocked?/termination thread-blocked-for-termination?)
    431434
    432 (: thread-blocked?/io deprecated)
     435(: thread-blocked?/io (deprecated thread-blocked-for-io?))
    433436(define thread-blocked?/io thread-blocked-for-io?)
    434437
    435 (: thread-blocked?/timeout deprecated)
     438(: thread-blocked?/timeout (deprecated thread-blocked-for-timeout?))
    436439(define thread-blocked?/timeout thread-blocked-for-timeout?)
    437440
Note: See TracChangeset for help on using the changeset viewer.