Changeset 13474 in project for release/4/synch
- Timestamp:
- 03/03/09 21:03:41 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/synch/trunk/synch.scm
r13472 r13474 168 168 169 169 (define-syntax set!/synch 170 (syntax-rules () 171 [(_ ?binding . ?body) ] ) ) 172 (if (pair? ?binding) 173 (let ([?var (car ?binding)] 174 [?mutex (cadr ?binding)]) 175 `(synch-with ,?mutex ,?var 176 (mutex-specific-set! ,?mutex (begin ,@?body)) 177 (mutex-specific ,?mutex) ) ) 178 (syntax-error 'set!/synch "invalid binding form" ?binding) ) ) 170 (lambda (form r c) 171 (##sys#check-syntax 'set!/synch form '(_ pair . _)) 172 (let ([$synch-with (r 'synch-with)] 173 [$mutex-specific (r 'mutex-specific)] 174 [$mutex-specific-set! (r 'mutex-specific-set!)] 175 [$begin (r 'begin)]) 176 (let ([?bnd (cadr form)] [?body (cddr form)]) 177 (let ([?var (car ?bnd)] 178 [?mtx (cadr ?bnd)]) 179 `(,$synch-with ,?mtx ,?var 180 (,$mutex-specific-set! ,?mtx (,$begin ,@?body)) 181 (,$mutex-specific ,?mtx) ) ) ) ) ) ) 179 182 180 183 (define-syntax synch/lock … … 200 203 201 204 (define-syntax object/synch 205 (lambda (form r c) 206 (##sys#check-syntax 'object/synch form '(_ _ . _)) 207 202 208 (syntax-rules () 203 209 [(_ ?mtx ?body ...) ] ) ) … … 226 232 227 233 (define-syntax record/synch 228 (syntax-rules () 229 [(_ ?sym ?rec ?body ...) ] ) ) 230 `(synch (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) 231 ?body ...) ) 234 (lambda (form r c) 235 (##sys#check-syntax 'record/synch form '(_ variable _ . _)) 236 (let ([$synch (r 'synch)]) 237 (let ([?sym (cadr form)] [?rec (caddr form)] [?body (cdddr form)]) 238 `(,$synch (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) ,@?body) ) ) ) ) 232 239 233 240 (define-syntax record-synch/lock 234 (syntax-rules () 235 [(_ ?sym ?rec ?body ...) ] ) ) 236 `(synch/lock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) 237 ?body ...) ) 241 (lambda (form r c) 242 (##sys#check-syntax 'record-synch/lock form '(_ variable _ . _)) 243 (let ([$synch/lock (r 'synch/lock)]) 244 (let ([?sym (cadr form)] [?rec (caddr form)] [?body (cdddr form)]) 245 `(,$synch/lock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) ,@?body) ) ) ) ) 238 246 239 247 (define-syntax record-synch/unlock 240 (syntax-rules () 241 [(_ ?sym ?rec ?body ...) ] ) ) 242 `(synch/unlock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) 243 ?body ...) ) 248 (lambda (form r c) 249 (##sys#check-syntax 'record-synch/unlock form '(_ variable _ . _)) 250 (let ([$synch/unlock (r 'synch/unlock)]) 251 (let ([?sym (cadr form)] [?rec (caddr form)] [?body (cdddr form)]) 252 `(,$synch/unlock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) ,@?body) ) ) ) ) 244 253 245 254 ;;; Unprotected … … 257 266 258 267 (define-syntax %synch-mutex-with* 268 259 269 (syntax-rules () 260 270 [(_ ?mtx ?var ?body ...) ] ) ) … … 295 305 296 306 (define-syntax %let/synch 307 297 308 (syntax-rules () 298 309 [(_ BINDINGS ?body ...) ] ) ) … … 309 320 310 321 (define-syntax %set!/synch 322 311 323 (syntax-rules () 312 324 [(_ ?binding . ?body) ] ) ) … … 320 332 321 333 (define-syntax %synch/lock 334 322 335 (syntax-rules () 323 336 [(_ ?mtx ?body ...) ] ) ) … … 333 346 334 347 (define-syntax %synch/unlock 348 335 349 (syntax-rules () 336 350 [(_ ?mtx ?body ...) ] ) ) … … 348 362 349 363 (define-syntax %object/synch 364 350 365 (syntax-rules () 351 366 [(_ ?mtx ?body ...) ] ) ) … … 374 389 375 390 (define-syntax %record/synch 391 (lambda (form r c) 392 (##sys#check-syntax 'object/synch form '(_ _ . _)) 393 376 394 (syntax-rules () 377 395 [(_ ?sym ?rec ?body ...) ] ) ) … … 380 398 381 399 (define-syntax %record-synch/lock 400 (lambda (form r c) 401 (##sys#check-syntax 'object/synch form '(_ _ . _)) 402 382 403 (syntax-rules () 383 404 [(_ ?sym ?rec ?body ...) ] ) ) … … 386 407 387 408 (define-syntax %record-synch/unlock 409 (lambda (form r c) 410 (##sys#check-syntax 'object/synch form '(_ _ . _)) 411 388 412 (syntax-rules () 389 413 [(_ ?sym ?rec ?body ...)
Note: See TracChangeset
for help on using the changeset viewer.