Changeset 39099 in project


Ignore:
Timestamp:
11/04/20 18:57:43 (3 weeks ago)
Author:
Kon Lovett
Message:

fix synch forms use of ?mtx syntax variable, delay evaluation of forms until use

Location:
release/5/synch/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • release/5/synch/trunk/synch-dyn.scm

    r38608 r39099  
    6363    ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...) ?abandon?) ?body ...)
    6464      ;eval args ahead of time
    65       (let (
    66         (mtx ?mtx)
    67         (lock-args (list ?lock-arg0 ...))
    68         (unlock-args (list ?unlock-arg0 ...))
    69         (abandon? ?abandon?) )
     65      (let ((mtx ?mtx))
    7066        ;do not continue when cannot get a lock
    71         (when (apply mutex-lock! ?mtx lock-args)
    72           (let (
    73             (ok? (not abandon?)) )
     67        (when (apply mutex-lock! mtx (list ?lock-arg0 ...))
     68          (let ((ok? (not ?abandon?)))
    7469            (let (
    7570              (result
    … …  
    7772                  void
    7873                  (lambda ()
    79                     (let (
    80                       (result (begin ?body ...)) )
     74                    (let ((result (begin ?body ...)))
    8175                      (set! ok? #t)
    8276                      result ) )
    8377                  (lambda ()
    84                     (when ok?
    85                       (apply mutex-unlock! ?mtx unlock-args))))) )
     78                    (when ok? (apply mutex-unlock! mtx (list ?unlock-arg0 ...)))))) )
    8679              (cond
    8780                ((not ok?)
    … …  
    9184    ;
    9285    ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?body ...)
    93       (let ((mtx ?mtx))
    94         (synch (mtx (?lock-arg0 ...) (?unlock-arg0 ...) #f) ?body ...) ) )
     86      (synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...) #f) ?body ...) )
    9587    ;
    9688    ((synch (?mtx (?lock-arg0 ...)) ?body ...)
    … …  
    10294    ((synch ?mtx ?body ...)
    10395      (synch (?mtx) ?body ...) ) ) )
     96
    10497;;
    10598
    … …  
    118111                  res))
    119112              (lambda ()
    120                 (unless ok?
    121                   (mutex-unlock! mtx)))) ) ) ) )
     113                (unless ok? (mutex-unlock! mtx)))) ) ) ) )
    122114    ;
    123115    ((synch-lock ?mtx ?body ...)

  • release/5/synch/trunk/synch-dynexn.scm

    r38608 r39099  
    6565    ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...) ?abandon?) ?body ...)
    6666      ;eval args ahead of time
    67       (let (
    68         (mtx ?mtx)
    69         (lock-args (list ?lock-arg0 ...))
    70         (unlock-args (list ?unlock-arg0 ...))
    71         (abandon? ?abandon?) )
     67      (let ((mtx ?mtx))
    7268        ;do not continue when cannot get a lock
    73         (when (apply mutex-lock! ?mtx lock-args)
    74           (let (
    75             (ok? (not abandon?))
    76             (exception? #f) )
     69        (when (apply mutex-lock! mtx (list ?lock-arg0 ...))
     70          (let ((ok? (not ?abandon?)) (exception? #f))
    7771            (let (
    7872              (result
    … …  
    8579                        (set! exception? #t)
    8680                        exn )
    87                       (let (
    88                         (result (begin ?body ...)) )
     81                      (let ((result (begin ?body ...)))
    8982                        (set! ok? #t)
    9083                        result ) ) )
    9184                  (lambda ()
    92                     (when ok?
    93                       (apply mutex-unlock! ?mtx unlock-args))))) )
     85                    (when ok? (apply mutex-unlock! mtx (list ?unlock-arg0 ...)))))) )
    9486              (cond
    9587                (exception?
    … …  
    10193    ;
    10294    ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?body ...)
    103       (let ((mtx ?mtx))
    104         (synch (mtx (?lock-arg0 ...) (?unlock-arg0 ...) #f) ?body ...) ) )
     95      (synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...) #f) ?body ...) )
    10596    ;
    10697    ((synch (?mtx (?lock-arg0 ...)) ?body ...)
    … …  
    112103    ((synch ?mtx ?body ...)
    113104      (synch (?mtx) ?body ...) ) ) )
     105
    114106;;
    115107
    … …  
    119111    ((synch-lock (?mtx (?lock-arg0 ...)) ?body ...)
    120112      ;eval args ahead of time
    121       (let (
    122         (lock-args (list ?lock-arg0 ...))
    123         (mtx ?mtx)
    124         (ok? #f) )
     113      (let ((mtx ?mtx) (ok? #f))
    125114        ;do not continue when cannot get a lock
    126         (when (apply mutex-lock! mtx lock-args)
     115        (when (apply mutex-lock! mtx (list ?lock-arg0 ...))
    127116          (dynamic-wind
    128117            void
    129118            (lambda ()
    130               (let (
    131                 (res (begin ?body ...)) )
     119              (let ((res (begin ?body ...)))
    132120                (set! ok? #t)
    133121                res))
    134122            (lambda ()
    135               (unless ok?
    136                 (mutex-unlock! mtx)))) ) ) )
     123              (unless ok? (mutex-unlock! mtx)))) ) ) )
    137124    ;
    138125    ((synch-lock ?mtx ?body ...)
    … …  
    143130    ;
    144131    ((synch-unlock (?mtx (?unlock-arg0 ...)) ?body ...)
    145       (let (
    146         (unlock-args (list ?unlock-arg0 ...))
    147         (mtx ?mtx) )
     132      (let ((mtx ?mtx))
    148133        ;race-condition
    149134        (let ((st (mutex-state mtx)))
    … …  
    153138              void
    154139              (lambda () ?body ...)
    155               (lambda () (apply mutex-unlock! mtx unlock-args)) ) ) ) ) )
     140              (lambda () (apply mutex-unlock! mtx (list ?unlock-arg0 ...))) ) ) ) ) )
    156141    ;
    157142    ((synch-unlock ?mtx ?body ...)

  • release/5/synch/trunk/synch-exn.scm

    r38608 r39099  
    6060    ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...) ?abandon?) ?body ...)
    6161      ;eval args ahead of time
    62       (let (
    63         (mtx ?mtx)
    64         (lock-args (list ?lock-arg0 ...))
    65         (unlock-args (list ?unlock-arg0 ...))
    66         (abandon? ?abandon?) )
     62      (let ((mtx ?mtx))
    6763        ;do not continue when cannot get a lock
    68         (when (apply mutex-lock! ?mtx lock-args)
    69           (let (
    70             (exception? #f) )
     64        (when (apply mutex-lock! mtx (list ?lock-arg0 ...))
     65          (let ((abandon? ?abandon?) (exception? #f) (unlock-args (list ?unlock-arg0 ...)))
    7166            (let (
    7267              (result
    … …  
    7469                  (begin
    7570                    (set! exception? #t)
    76                     (unless abandon?
    77                       (apply mutex-unlock! ?mtx unlock-args))
     71                    (unless abandon? (apply mutex-unlock! mtx unlock-args))
    7872                    exn )
    79                   (let (
    80                     (result (begin ?body ...)) )
    81                     (apply mutex-unlock! ?mtx unlock-args)
     73                  (let ((result (begin ?body ...)))
     74                    (apply mutex-unlock! mtx unlock-args)
    8275                    result ) ) ) )
    8376              (cond
    … …  
    8881    ;
    8982    ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?body ...)
    90       (let ((mtx ?mtx))
    91         (synch (mtx (?lock-arg0 ...) (?unlock-arg0 ...) #f) ?body ...) ) )
     83      (synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...) #f) ?body ...) )
    9284    ;
    9385    ((synch (?mtx (?lock-arg0 ...)) ?body ...)
    … …  
    116108                  res))
    117109              (lambda ()
    118                 (unless ok?
    119                   (mutex-unlock! mtx)))) ) ) ) )
     110                (unless ok? (mutex-unlock! mtx)))) ) ) ) )
    120111    ;
    121112    ((synch-lock ?mtx ?body ...)

  • release/5/synch/trunk/synch.egg

    r38942 r39099  
    44
    55((synopsis "Synchronization Forms")
    6  (version "3.3.0")
     6 (version "3.3.1")
    77 (category hell)
    88 (author "[[kon lovett]]")
Note: See TracChangeset for help on using the changeset viewer.