Changeset 34999 in project


Ignore:
Timestamp:
01/11/18 02:58:17 (5 months ago)
Author:
kon
Message:

sane rename , slower pussycat , wtf

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

Legend:

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

    r34998 r34999  
    66;;
    77;; - umm, just look
    8 ;;
    9 ;; - clojure validators and watches
    108;;
    119;;  - something like mutex-conditions for state-change watchers?
     
    2018  (no-bound-checks)
    2119  (no-argc-checks)
    22   ;shouldn't be needed but lock overhead
     20  ;shouldn't be but spin+lock overhead
    2321  (disable-interrupts) )
    2422
     
    207205;
    208206
    209 (define-inline (<atom>-compare-and-set! atm old new pred?)
    210   ;used by the "spin-lock"
    211   ;(this buys nothing)
     207(define-inline (<atom>-compare-and-set! atm old new pred?)  ;--> boolean
    212208  (and
    213209    (pred? (<atom>-value atm) old)
     210    (<atom>-value-set! atm new)
     211    ;need non-false result
     212    #t ) )
     213
     214;used by the "spin-lock"
     215(define-inline (<atom>-compare-and-set!-synch atm old new pred?)  ;--> boolean
     216  (and
     217    (pred? (<atom>-value atm) old)  ;(this buys nothing)
    214218    (<atom>-synch atm
    215       (and
    216         (pred? (<atom>-value atm) old)
    217         (begin
    218           (<atom>-value-set! atm new)
    219           #t ) ) ) ) )
     219      (<atom>-compare-and-set! atm old new pred?) ) ) )
    220220
    221221;
    222222
    223223;-> <newval>
    224 (define-syntax <atom>-compare-and-set!-synch
     224(define-syntax <atom>-compare-and-set!-until
    225225  (syntax-rules ()
    226226    ;
    227227    ((_ ?atm (?_old ?old) (?_new ?new))
    228       (<atom>-compare-and-set!-synch ?atm (?_old ?old) (?_new ?new) eq?) )
     228      (<atom>-compare-and-set!-until ?atm (?_old ?old) (?_new ?new) eq?) )
    229229    ;
    230230    ((_ ?atm (?_old ?old) (?_new ?new) ?pred?)
    231231      (let ((_atm ?atm) (_pred? ?pred?))
    232         (spin-until: (<atom>-compare-and-set! _atm ?_old ?_new _pred?)
     232        (spin-until: (<atom>-compare-and-set!-synch _atm ?_old ?_new _pred?)
    233233          from: (?_old ?old)
    234234          to: (?_new ?new)) ) ) ) )
    235235
    236 (define-inline (<atom>-value-apply!-synch atm old func args)
    237   (<atom>-compare-and-set!-synch atm (_old old) (_new (apply func _old args))) )
     236(define-inline (<atom>-value-apply!-until atm old func args)
     237  (<atom>-compare-and-set!-until atm
     238    (_old old)
     239    (_new (apply func _old args))) )
    238240
    239241;
     
    248250    ((_ ?atm ?_old (?_new ?new) ?pred?)
    249251      (let ((_atm ?atm) (_pred? ?pred?))
    250         (spin-until: (<atom>-compare-and-set! _atm ?_old ?_new _pred?)
     252        (spin-until: (<atom>-compare-and-set!-synch _atm ?_old ?_new _pred?)
    251253          from: (?_old (<atom>-value _atm))
    252254          to: (?_new ?new)) ) ) ) )
    253255
    254256(define-inline (<atom>-value-apply!-stable atm func args)
    255   (<atom>-compare-and-set!-stable atm _old (_new (apply func _old args))) )
     257  (<atom>-compare-and-set!-stable atm
     258    _old
     259    (_new (apply func _old args))) )
    256260
    257261;;
     
    287291(apply signal-type-error loc (make-error-type-message 'atom) args) )
    288292
    289 ;NOTE the {{next}} need only return a value for the atom ,
    290 ;side-effects are extra - so validators & watchers are possible
    291 ;via a suitable {{next}}.
     293;;
     294
     295;{{next}} need only return a value for the atom , side-effects are extra - so
     296;validators & watchers are possible via a suitable {{next}}.
    292297;
    293298;but the {{next}} better be quick, disable-interrupts remember.
     
    308313(define: (atom-mutate (atm <atom>) (mutt procedure)) --> <atom>
    309314  (check-procedure 'atom-mutate mutt 'mutate)
    310   (check-<atom> 'atom-mutate atm)
    311   (<atom>-synch atm (<atom>-wrap atm #:after (lambda (_ n) (mutt n)))) )
     315  (<atom>-synch (check-<atom> 'atom-mutate atm)
     316    (<atom>-wrap atm #:after (lambda (_ n) (mutt n)))) )
    312317
    313318;(* --> boolean)
    314319(define: (atom-validate (atm <atom>) (vald? procedure)) --> <atom>
    315320  (check-procedure 'atom-validate vald? 'valid?)
    316   (check-<atom> 'atom-validate atm)
    317   (<atom>-synch atm (<atom>-wrap atm #:after (lambda (o n) (if (vald? n) n o)))) )
     321  (<atom>-synch (check-<atom> 'atom-validate atm)
     322    (<atom>-wrap atm #:after (lambda (o n) (if (vald? n) n o)))) )
    318323
    319324;(* * --> *)
    320325(define: (atom-watch (atm <atom>) (mode symbol) (wtch procedure)) --> <atom>
    321   (check-<atom> 'atom-apply! atm)
    322326  (check-symbol 'atom-watch mode 'mode)
    323327  (check-procedure 'atom-watch wtch 'watch)
    324   (<atom>-synch atm (<atom>-wrap atm mode wtch)) )
     328  (<atom>-synch (check-<atom> 'atom-apply! atm)
     329    (<atom>-wrap atm mode wtch)) )
    325330
    326331;;
     
    340345;
    341346(define: (atom-compare-and-set! (atm <atom>) (old *) (new *)) -> boolean
    342   (<atom>-compare-and-set! (check-<atom> 'atom-compare-and-set! atm) old new eq?) )
     347  (<atom>-compare-and-set!-synch
     348    (check-<atom> 'atom-compare-and-set! atm)
     349    old new
     350    eq?) )
    343351
    344352;;
     
    375383;
    376384(define: (atom-wait-and-apply! (atm <atom>) (old *) (func procedure) (args (list-of *)))
    377   (<atom>-value-apply!-synch
     385  (<atom>-value-apply!-until
    378386    (check-<atom> 'atom-wait-and-apply! atm)
    379387    old
     
    385393;
    386394(define: (atom-wait-and-call! (atm <atom>) (old *) (func procedure) . (args (list-of *)))
    387   (<atom>-value-apply!-synch
     395  (<atom>-value-apply!-until
    388396    (check-<atom> 'atom-wait-and-call! atm)
    389397    old
  • release/4/thread-utils/trunk/tests/atomic-value-test.scm

    r34998 r34999  
    11;;;; atomic-value-test.scm -*- Hen -*-
    22
    3 (use test)
    4 
    5 (use atomic-value)
    6 (use srfi-1 srfi-18)
     3(use
     4  test
     5  atomic-value
     6  srfi-1 srfi-18
     7  data-structures)
    78
    89;;;
     
    1011(cond-expand (chicken-4 (use numbers)))
    1112
    12 #|
     13#| ;UNTIL RELEASE
    1314(use typed-define)
    14 
    1515;
    1616(define: (atom-zero! (atm <atom>)) -> number
    1717  (atom-set! atm 0) )
    18 
    1918;
    2019(define: (atom-add1! (atm <atom>)) -> number
    2120  (atom-call! atm add1) )
    22 
    2321;
    2422(define: (atom-sub1! (atm <atom>)) -> number
     
    2826(define (atom-zero! atm)
    2927  (atom-set! atm 0) )
    30 
    3128;
    3229(define (atom-add1! atm)
    3330  (atom-call! atm add1) )
    34 
    3531;
    3632(define (atom-sub1! atm)
     
    117113    (make-random-activation-atom-add1-threads atm lim)) )
    118114
    119 (test-begin "many threads; please wait")
    120 (test-group
    121   (string-append
    122     "with "
    123     (number->string *loop-limit*) " updaters w/ random waiting <= "
    124     (number->string *wait-limit*) "ms")
    125   ;
     115(test-begin (conc *loop-limit* " threads; please wait"))
     116(test-group (conc "with " *loop-limit* " updaters w/ random waiting <= " *wait-limit* "ms")
    126117  (let ((counter (atom 0)))
    127118    ;run all the mutators & enjoin to primordial
Note: See TracChangeset for help on using the changeset viewer.