Changeset 39099 in project
- Timestamp:
- 11/04/20 18:57:43 (4 months ago)
- Location:
- release/5/synch/trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/synch/trunk/synch-dyn.scm
r38608 r39099 63 63 ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...) ?abandon?) ?body ...) 64 64 ;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)) 70 66 ;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?))) 74 69 (let ( 75 70 (result … … 77 72 void 78 73 (lambda () 79 (let ( 80 (result (begin ?body ...)) ) 74 (let ((result (begin ?body ...))) 81 75 (set! ok? #t) 82 76 result ) ) 83 77 (lambda () 84 (when ok? 85 (apply mutex-unlock! ?mtx unlock-args))))) ) 78 (when ok? (apply mutex-unlock! mtx (list ?unlock-arg0 ...)))))) ) 86 79 (cond 87 80 ((not ok?) … … 91 84 ; 92 85 ((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 ...) ) 95 87 ; 96 88 ((synch (?mtx (?lock-arg0 ...)) ?body ...) … … 102 94 ((synch ?mtx ?body ...) 103 95 (synch (?mtx) ?body ...) ) ) ) 96 104 97 ;; 105 98 … … 118 111 res)) 119 112 (lambda () 120 (unless ok? 121 (mutex-unlock! mtx)))) ) ) ) ) 113 (unless ok? (mutex-unlock! mtx)))) ) ) ) ) 122 114 ; 123 115 ((synch-lock ?mtx ?body ...) -
release/5/synch/trunk/synch-dynexn.scm
r38608 r39099 65 65 ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...) ?abandon?) ?body ...) 66 66 ;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)) 72 68 ;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)) 77 71 (let ( 78 72 (result … … 85 79 (set! exception? #t) 86 80 exn ) 87 (let ( 88 (result (begin ?body ...)) ) 81 (let ((result (begin ?body ...))) 89 82 (set! ok? #t) 90 83 result ) ) ) 91 84 (lambda () 92 (when ok? 93 (apply mutex-unlock! ?mtx unlock-args))))) ) 85 (when ok? (apply mutex-unlock! mtx (list ?unlock-arg0 ...)))))) ) 94 86 (cond 95 87 (exception? … … 101 93 ; 102 94 ((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 ...) ) 105 96 ; 106 97 ((synch (?mtx (?lock-arg0 ...)) ?body ...) … … 112 103 ((synch ?mtx ?body ...) 113 104 (synch (?mtx) ?body ...) ) ) ) 105 114 106 ;; 115 107 … … 119 111 ((synch-lock (?mtx (?lock-arg0 ...)) ?body ...) 120 112 ;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)) 125 114 ;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 ...)) 127 116 (dynamic-wind 128 117 void 129 118 (lambda () 130 (let ( 131 (res (begin ?body ...)) ) 119 (let ((res (begin ?body ...))) 132 120 (set! ok? #t) 133 121 res)) 134 122 (lambda () 135 (unless ok? 136 (mutex-unlock! mtx)))) ) ) ) 123 (unless ok? (mutex-unlock! mtx)))) ) ) ) 137 124 ; 138 125 ((synch-lock ?mtx ?body ...) … … 143 130 ; 144 131 ((synch-unlock (?mtx (?unlock-arg0 ...)) ?body ...) 145 (let ( 146 (unlock-args (list ?unlock-arg0 ...)) 147 (mtx ?mtx) ) 132 (let ((mtx ?mtx)) 148 133 ;race-condition 149 134 (let ((st (mutex-state mtx))) … … 153 138 void 154 139 (lambda () ?body ...) 155 (lambda () (apply mutex-unlock! mtx unlock-args)) ) ) ) ) )140 (lambda () (apply mutex-unlock! mtx (list ?unlock-arg0 ...))) ) ) ) ) ) 156 141 ; 157 142 ((synch-unlock ?mtx ?body ...) -
release/5/synch/trunk/synch-exn.scm
r38608 r39099 60 60 ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...) ?abandon?) ?body ...) 61 61 ;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)) 67 63 ;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 ...))) 71 66 (let ( 72 67 (result … … 74 69 (begin 75 70 (set! exception? #t) 76 (unless abandon? 77 (apply mutex-unlock! ?mtx unlock-args)) 71 (unless abandon? (apply mutex-unlock! mtx unlock-args)) 78 72 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) 82 75 result ) ) ) ) 83 76 (cond … … 88 81 ; 89 82 ((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 ...) ) 92 84 ; 93 85 ((synch (?mtx (?lock-arg0 ...)) ?body ...) … … 116 108 res)) 117 109 (lambda () 118 (unless ok? 119 (mutex-unlock! mtx)))) ) ) ) ) 110 (unless ok? (mutex-unlock! mtx)))) ) ) ) ) 120 111 ; 121 112 ((synch-lock ?mtx ?body ...) -
release/5/synch/trunk/synch.egg
r38942 r39099 4 4 5 5 ((synopsis "Synchronization Forms") 6 (version "3.3. 0")6 (version "3.3.1") 7 7 (category hell) 8 8 (author "[[kon lovett]]")
Note: See TracChangeset
for help on using the changeset viewer.