Changeset 34416 in project


Ignore:
Timestamp:
08/27/17 05:03:41 (3 months ago)
Author:
kon
Message:

bump ver, re-flow

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

Legend:

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

    r28429 r34416  
    1919(module thread-reaper
    2020
    21   (;export
    22     thread-reaper-shutdown?
    23     thread-reap!
    24     thread-reaper-stop!
    25     thread-reaper-greedy
    26     thread-reaper-quantum
    27     thread-reaper-wait-seconds
    28     thread-reaper-timeout
    29     thread-reaper-retries)
    30 
    31   (import
    32     scheme
    33     chicken
    34     (only data-structures
    35       queue-empty? queue-remove! make-queue queue-add! queue->list)
    36     (only srfi-18
    37       thread-name thread-sleep!
    38       thread-join! thread-yield! thread-start! make-thread
    39       thread-quantum-set! thread-quantum
    40       terminated-thread-exception? uncaught-exception?)
    41     (only miscmacros until)
    42     (only synch
    43       make-object/synch synch-with %synch-with)
    44     (only record-variants
    45       define-record-type-variant)
    46     (only thread-utils
    47       check-thread print-exception-warning)
    48     (only type-checks
    49       check-positive-number check-natural-fixnum))
    50 
    51   (require-library
    52     data-structures srfi-18
    53     record-variants miscmacros
    54     synch thread-utils)
     21(;export
     22  thread-reaper-shutdown?
     23  thread-reap!
     24  thread-reaper-stop!
     25  thread-reaper-greedy
     26  thread-reaper-quantum
     27  thread-reaper-wait-seconds
     28  thread-reaper-timeout
     29  thread-reaper-retries)
     30
     31(import scheme)
     32
     33(import
     34  chicken
     35  (only data-structures
     36    queue-empty? queue-remove! make-queue queue-add! queue->list)
     37  (only srfi-18
     38    thread-name thread-sleep!
     39    thread-join! thread-yield! thread-start! make-thread
     40    thread-quantum-set! thread-quantum
     41    terminated-thread-exception? uncaught-exception?) )
     42
     43(import
     44  (only miscmacros until)
     45  (only synch
     46    make-object/synch synch-with %synch-with)
     47  (only record-variants
     48    define-record-type-variant)
     49  (only thread-utils
     50    check-thread print-exception-warning)
     51  (only type-checks
     52    check-positive-number check-natural-fixnum))
     53(require-library
     54  record-variants miscmacros
     55  synch thread-utils)
    5556
    5657;;
     
    7273
    7374;Local to this module
    74 (define-record-type-variant reap-item
    75   (unsafe unchecked inline)
     75(define-record-type-variant reap-item (unsafe unchecked inline)
    7676  (make-reap-item th to rt)
    7777  reap-item?
     
    8989         (th (reap-item-thread ri))
    9090         (to (reap-item-timeout ri)) )
    91     (handle-exceptions exn
    92         (begin
    93           #; ;FIXME should we put the offender back?
    94           (queue-add! thq ri)
    95           (print-exception-warning exn) )
     91    (handle-exceptions
     92      ;as
     93      exn
     94      ;with
     95      (begin
     96        #; ;FIXME should we put the offender back?
     97        (queue-add! thq ri)
     98        (print-exception-warning exn) )
     99      ;in
    96100      (let ((res (thread-join! th to REAP-TIMED-OUT)))
    97101        ;Try again if it just timed-out
    98102        (when (eq? REAP-TIMED-OUT res)
    99103          (let ((rt (reap-item-retries ri)))
    100             (if (fx= 0 rt) (warning "cannot reap thread" th)
     104            (if (fx= 0 rt)
     105              (warning "cannot reap thread" th)
    101106              (begin
    102107                (set-reap-item-retries! ri (fx- rt 1))
     
    135140(define-inline (reap)
    136141  (%synch-with +threads+ threads
    137     (if +greedy?+ (reap-thread-queue threads)
     142    (if +greedy?+
     143      (reap-thread-queue threads)
    138144      (reap-thread-queue-top threads) ) ) )
    139145
     
    142148(define (reaper)
    143149  (let loop ()
    144     (if +stopping?+ (reap-all)
     150    (if +stopping?+
     151      (reap-all)
    145152      (begin
    146153        (reap)
    147         ;FIXME this causes busy loop!
    148         #;(thread-yield!)
     154        #; ;FIXME this causes busy loop!
     155        (thread-yield!)
    149156        (thread-sleep! 1.0)
    150157        (loop) ) ) ) )
     
    165172
    166173(define (thread-reaper-start!)
    167   ;ensure reasonable state anyway.
    168   (unless +threads+         ;Only done once
     174  ;ensure reasonable state anyway
     175  (unless +threads+
     176    ;only done once
    169177    (set! +threads+ (make-object/synch (make-queue) '(queue/synch-)))
    170     ;Clean shutdown
     178    ;clean shutdown
    171179    (on-exit thread-reaper-shutdown!) )
    172   (unless +reaper-thread+   ;Whenever no reaper
     180  ;whenever no reaper
     181  (unless +reaper-thread+
    173182    (set! +stopping?+ #f)
    174183    (set! +reaper-thread+ (make-thread reaper 'thread-reaper))
     
    199208
    200209(define (thread-reaper-greedy . args)
    201   (if (null? args) +greedy?+
     210  (if (null? args)
     211    +greedy?+
    202212    (set! +greedy?+ (and (car args) #t)) ) )
    203213
     
    205215  (cond
    206216    (+reaper-thread+
    207       (if (null? args) (thread-quantum +reaper-thread+)
     217      (if (null? args)
     218        (thread-quantum +reaper-thread+)
    208219        (unless (or +stopping?+ +shutdown?+)
    209220          (thread-quantum-set! +reaper-thread+ (car args)) ) ) )
     
    212223
    213224(define (thread-reaper-wait-seconds . args)
    214   (if (null? args) +wait-seconds+
     225  (if (null? args)
     226    +wait-seconds+
    215227    (let ((to (car args)))
    216228      (set! +wait-seconds+
     
    218230
    219231(define (thread-reaper-timeout . args)
    220   (if (null? args) +timeout+
     232  (if (null? args)
     233    +timeout+
    221234    (let ((to (car args)))
    222235      (set! +timeout+
     
    224237
    225238(define (thread-reaper-retries . args)
    226   (if (null? args) +retries+
     239  (if (null? args)
     240    +retries+
    227241    (let ((rt (car args)))
    228242      (set! +retries+ (check-natural-fixnum 'thread-reaper-retries rt)) ) ) )
  • release/4/thread-utils/trunk/thread-utils.scm

    r21008 r34416  
    88(module thread-utils
    99
    10   (;export
    11     ;
    12     thread-warning-message
    13     print-exception-error
    14     print-exception-warning
    15     ;
    16     make-thread-timeout
    17     thread-timeout? check-thread-timeout error-thread-timeout
    18     ;
    19     check-thread error-thread
    20     ;
    21     thread-state=?
    22     thread-created?
    23     thread-ready?
    24     thread-running?
    25     thread-blocked?
    26     thread-suspended?
    27     thread-sleeping?
    28     thread-terminated?
    29     thread-dead?
    30     thread-obstructed?
    31     ;
    32     thread-blocked?/termination
    33     thread-blocked?/io
    34     thread-blocked?/timeout
    35     ;
    36     thread-unblock!)
     10(;export
     11  ;
     12  thread-warning-message
     13  print-exception-error
     14  print-exception-warning
     15  ;
     16  make-thread-timeout
     17  thread-timeout? check-thread-timeout error-thread-timeout
     18  ;
     19  check-thread error-thread
     20  ;
     21  thread-state=?
     22  thread-created?
     23  thread-ready?
     24  thread-running?
     25  thread-blocked?
     26  thread-suspended?
     27  thread-sleeping?
     28  thread-terminated?
     29  thread-dead?
     30  thread-obstructed?
     31  ;
     32  thread-blocked?/termination
     33  thread-blocked?/io
     34  thread-blocked?/timeout
     35  ;
     36  thread-unblock!)
    3737
    38   (import
    39     scheme
    40     chicken
    41     (only srfi-18
    42       thread-state thread? current-thread
    43       condition-variable?
    44       mutex?
    45       time? seconds->time time->seconds current-time)
    46     (only type-checks define-check+error-type))
     38(import scheme)
    4739
    48   (require-library srfi-18 type-checks)
     40(import chicken
     41  (only srfi-18
     42    thread-state thread? current-thread
     43    condition-variable?
     44    mutex?
     45    time? seconds->time time->seconds current-time) )
     46
     47(import (only type-checks define-check+error-type))
     48(require-library type-checks)
    4949
    5050;; Thread Messages
     
    114114;;
    115115
    116 (define (thread-state=? th tk) (eq? tk (thread-state th)))
     116(define (thread-state=? th tk)
     117        (eq? tk (thread-state th)) )
    117118
    118 (define (thread-created? th) (thread-state=? th 'created))
    119 (define (thread-ready? th) (thread-state=? th 'ready))
    120 (define (thread-running? th) (thread-state=? th 'running))
    121 (define (thread-blocked? th) (thread-state=? th 'blocked))
    122 (define (thread-suspended? th) (thread-state=? th 'suspended))
    123 (define (thread-sleeping? th) (thread-state=? th 'sleeping))
    124 (define (thread-terminated? th) (thread-state=? th 'terminated))
    125 (define (thread-dead? th) (thread-state=? th 'dead))
     119(define (thread-created? th)
     120        (thread-state=? th 'created) )
    126121
    127 (define (thread-obstructed? th) (or (thread-blocked? th) (thread-sleeping? th)))
     122(define (thread-ready? th)
     123        (thread-state=? th 'ready) )
     124
     125(define (thread-running? th)
     126        (thread-state=? th 'running) )
     127
     128(define (thread-blocked? th)
     129        (thread-state=? th 'blocked) )
     130
     131(define (thread-suspended? th)
     132        (thread-state=? th 'suspended) )
     133
     134(define (thread-sleeping? th)
     135        (thread-state=? th 'sleeping) )
     136
     137(define (thread-terminated? th)
     138        (thread-state=? th 'terminated) )
     139
     140(define (thread-dead? th)
     141        (thread-state=? th 'dead) )
     142
     143(define (thread-obstructed? th)
     144        (or (thread-blocked? th) (thread-sleeping? th)) )
    128145
    129146;;
    130147
    131148(define (*thread-blocked?/object th)
    132   (and (thread-blocked? th)
    133        (*thread-block-object th)) )
     149  (and
     150    (thread-blocked? th)
     151    (*thread-block-object th)) )
    134152
    135153(define (thread-blocked?/termination th)
    136   (and (thread-blocked? th)
    137        ;FIXME accurate but imprecise
    138        (*thread-recipients th)
    139        #t ) )
     154  (and
     155    (thread-blocked? th)
     156    ;FIXME accurate but imprecise
     157    (*thread-recipients th)
     158    #t ) )
    140159
    141160(define (thread-blocked?/timeout th)
    142   (and (thread-blocked? th)
    143        (not (*thread-block-object th))
    144        (*thread-block-timeout th)
    145        #t ) )
     161  (and
     162    (thread-blocked? th)
     163    (not (*thread-block-object th))
     164    (*thread-block-timeout th)
     165    #t ) )
    146166
    147167(define (thread-blocked?/io th)
     
    158178
    159179(define (thread-unblock! th)
    160   (when (thread-blocked?/timeout th) (##sys#thread-unblock! th))
     180  (when (thread-blocked?/timeout th)
     181    (##sys#thread-unblock! th) )
    161182  #;
    162183  (when (thread-obstructed? th)
  • release/4/thread-utils/trunk/thread-utils.setup

    r30539 r34416  
    55(verify-extension-name "thread-utils")
    66
    7 (setup-shared-extension-module 'thread-utils (extension-version "1.0.3")
     7(setup-shared-extension-module 'thread-utils (extension-version "1.0.4")
    88  #:inline? #t
    99  #:types? #t
     
    1313    -no-procedure-checks) )
    1414
    15 (setup-shared-extension-module 'thread-reaper (extension-version "1.0.3")
     15(setup-shared-extension-module 'thread-reaper (extension-version "1.0.4")
    1616  #:inline? #t
    1717  #:types? #t
Note: See TracChangeset for help on using the changeset viewer.