Changeset 34995 in project


Ignore:
Timestamp:
01/08/18 20:35:02 (8 days ago)
Author:
kon
Message:

be stable , rrrrrrr

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

Legend:

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

    r34994 r34995  
    3939  ;
    4040  atom-compare-and-set!
    41   atom-compare-and-set-with-apply! atom-compare-and-set-with-call!
     41  atom-wait-and-apply! atom-wait-and-call!
    4242  ;
    4343  atom-set!
     
    4747  atom-swap!)
    4848
    49 (import
    50   scheme
    51   chicken)
    52 
     49(import scheme chicken)
    5350(use
    5451  srfi-18
    5552  (only data-structures identity)
    5653  (only miscmacros define-parameter)
    57   (only moremacros ->boolean)
    5854  (only type-checks check-structure check-procedure check-symbol)
    5955  (only type-errors signal-type-error make-error-type-message)
     
    182178          #t ) ) ) ) )
    183179
     180;
     181
    184182;-> <newval>
    185183(define-syntax <atom>-compare-and-set!-synch
     
    195193          while: (?_new ?new)) ) ) ) )
    196194
     195(define-inline (<atom>-value-apply!-synch atm old func args)
     196  (<atom>-compare-and-set!-synch atm (_old old) (_new (apply func _old args))) )
     197
     198;
     199
    197200;-> <newval>
    198201(define-syntax <atom>-compare-and-set!-stable
     
    207210          from: (?_old (<atom>-value _atm))
    208211          while: (?_new ?new)) ) ) ) )
    209 
    210 (define-inline (<atom>-value-apply!-synch atm old func args)
    211   (<atom>-compare-and-set!-synch atm (_old old) (_new (apply func _old args))) )
    212212
    213213(define-inline (<atom>-value-apply!-stable atm func args)
     
    310310  (<atom>-compare-and-set! (check-<atom> 'atom-compare-and-set! atm) old new eq?) )
    311311
    312 ;
    313 (define: (atom-compare-and-set-with-apply! (atm <atom>) (old *) (func procedure) (args (list-of *)))
    314   (<atom>-value-apply!-synch
    315     (check-<atom> 'atom-compare-and-set-with-apply! atm)
    316     old
    317     (check-procedure 'atom-compare-and-set-with-apply! func)
    318     args) )
    319 
    320 ;
    321 (define: (atom-compare-and-set-with-call! (atm <atom>) (old *) (func procedure) . (args (list-of *)))
    322   (<atom>-value-apply!-synch
    323     (check-<atom> 'atom-compare-and-set-with-call! atm)
    324     old
    325     (check-procedure 'atom-compare-and-set-with-call! func)
    326     args) )
    327 
    328312;;
    329313
     
    333317    (check-<atom> 'atom-swap! atm)
    334318    _old
    335     (_new val)) )
     319    (_new val))
     320  ;
     321  (void) )
    336322
    337323;
     
    340326    (check-<atom> 'atom-apply! atm)
    341327    (check-procedure 'atom-apply! func)
    342     args) )
     328    args)
     329  ;
     330  (void) )
    343331
    344332;
     
    347335    (check-<atom> 'atom-call! atm)
    348336    (check-procedure 'atom-call! func)
    349     args) )
     337    args)
     338  ;
     339  (void) )
     340
     341;;
     342
     343;
     344(define: (atom-wait-and-apply! (atm <atom>) (old *) (func procedure) (args (list-of *)))
     345  (<atom>-value-apply!-synch
     346    (check-<atom> 'atom-wait-and-apply! atm)
     347    old
     348    (check-procedure 'atom-wait-and-apply! func)
     349    args)
     350  ;
     351  (void) )
     352
     353;
     354(define: (atom-wait-and-call! (atm <atom>) (old *) (func procedure) . (args (list-of *)))
     355  (<atom>-value-apply!-synch
     356    (check-<atom> 'atom-wait-and-call! atm)
     357    old
     358    (check-procedure 'atom-wait-and-call! func)
     359    args)
     360  ;
     361  (void) )
    350362
    351363;;
  • release/4/thread-utils/trunk/tests/atomic-value-test.scm

    r34994 r34995  
    1919;
    2020(define: (atom-zero! (atm <atom>)) -> number
    21   (atom-set! atm 0)
    22   (atom-value atm) )
     21  (atom-set! atm 0) )
    2322
    2423;
    2524(define: (atom-add1! (atm <atom>)) -> number
    26   (atom-call! atm add1)
    27   (atom-value atm) )
     25  (atom-call! atm add1) )
    2826
    2927;
    3028(define: (atom-sub1! (atm <atom>)) -> number
    31   (atom-call! atm sub1)
    32   (atom-value atm) )
     29  (atom-call! atm sub1) )
    3330|#
    3431;
     
    3835;
    3936(define (atom-zero! atm)
    40   (atom-set! atm 0)
    41   #;(atom-value atm) )
     37  (atom-set! atm 0) )
    4238
    4339;
    4440(define (atom-add1! atm)
    45   (atom-call! atm add1)
    46   #;(atom-value atm) )
     41  (atom-call! atm add1) )
    4742
    4843;
    4944(define (atom-sub1! atm)
    50   (atom-call! atm sub1)
    51   #;(atom-value atm) )
     45  (atom-call! atm sub1) )
    5246
    5347;;;
     
    7771(test-group "list mutate"
    7872  (let ((foo (atom (list))))
    79     (atom-compare-and-set-with-call! foo (atom-value foo) xcons 3)
    80     (atom-compare-and-set-with-call! foo (atom-value foo) xcons 2)
    81     (atom-compare-and-set-with-call! foo (atom-value foo) xcons 1)
     73    (atom-wait-and-call! foo (atom-value foo) xcons 3)
     74    (atom-wait-and-call! foo (atom-value foo) xcons 2)
     75    (atom-wait-and-call! foo (atom-value foo) xcons 1)
    8276    (test '(1 2 3) (atom-value foo)) )
    8377)
     
    8781(test-group "counter"
    8882  (let ((a (make-atom)))
    89     (test 0 (atom-zero! a))
    90     (test 1 (atom-add1! a))
    91     (test 0 (atom-sub1! a)) )
     83    (test 0 (begin (atom-zero! a) (atom-value a)))
     84    (test 1 (begin (atom-add1! a) (atom-value a)))
     85    (test 0 (begin (atom-sub1! a) (atom-value a))) )
    9286)
    9387
     
    9892(test-group "counter w/ mutator"
    9993  (let ((a (atom-wrap add1)))
    100     (test 1 (atom-zero! a))     ;0    +1
    101     (test 3 (atom-add1! a))     ;1 +1 +1
    102     (test 3 (atom-sub1! a)) )   ;3 -1 +1
     94    (test 1 (begin (atom-zero! a) (atom-value a)))     ;0    +1
     95    (test 3 (begin (atom-add1! a) (atom-value a)))     ;1 +1 +1
     96    (test 3 (begin (atom-sub1! a) (atom-value a))) )   ;3 -1 +1
    10397)
    10498
     
    122116  (string-append
    123117    "with "
    124     (number->string *loop-limit*) " updaters w/ random waiting in "
     118    (number->string *loop-limit*) " updaters w/ random waiting <= "
    125119    (number->string *wait-limit*) "ms")
    126120
  • release/4/thread-utils/trunk/thread-reaper.scm

    r34416 r34995  
    2929  thread-reaper-retries)
    3030
    31 (import scheme)
    32 
    33 (import
    34   chicken
     31(import scheme chicken)
     32(use
    3533  (only data-structures
    3634    queue-empty? queue-remove! make-queue queue-add! queue->list)
     
    3937    thread-join! thread-yield! thread-start! make-thread
    4038    thread-quantum-set! thread-quantum
    41     terminated-thread-exception? uncaught-exception?) )
    42 
    43 (import
     39    terminated-thread-exception? uncaught-exception?)
    4440  (only miscmacros until)
    4541  (only synch
     
    5147  (only type-checks
    5248    check-positive-number check-natural-fixnum))
    53 (require-library
    54   record-variants miscmacros
    55   synch thread-utils)
    5649
    5750;;
  • release/4/thread-utils/trunk/thread-utils.meta

    r34914 r34995  
    1111  (record-variants "0.5")
    1212  (miscmacros "2.96")
    13   (moremacros "1.4.2")
    1413  (dsssl-utils "2.1.0")
    1514        (synch "2.1.0")
  • release/4/thread-utils/trunk/thread-utils.scm

    r34571 r34995  
    7777  thread-blocked?/timeout )
    7878
    79 (import scheme)
    80 
    81 (import chicken)
    82 
    83 (import (only srfi-1 any))
    84 (require-library srfi-1)
    85 
    86 (import
     79(import scheme chicken)
     80(use
     81  (only srfi-1 any)
    8782  (only srfi-18
    8883    thread-state thread? current-thread
    8984    condition-variable?
    9085    mutex?
    91     time? seconds->time time->seconds current-time) )
    92 (require-library srfi-18)
    93 
    94 (import (only type-checks define-check+error-type))
    95 (require-library type-checks)
     86    time? seconds->time time->seconds current-time)
     87  (only type-checks define-check+error-type))
    9688
    9789;; Thread Messages
Note: See TracChangeset for help on using the changeset viewer.