Changed lock-region to use proc objects instead of pids, and fixed a

bug in UNLOCK-REGION.
This commit is contained in:
shivers 1996-11-10 13:59:58 +00:00
parent ea9745ee2f
commit 454808a9cd
1 changed files with 21 additions and 8 deletions

View File

@ -51,7 +51,7 @@
start ; integer start ; integer
len ; Positive integer or #f len ; Positive integer or #f
whence ; seek/set, seek/delta, or seek/end. whence ; seek/set, seek/delta, or seek/end.
pid ; Process holding lock proc ; Process holding lock
) )
(define lock-region? %lock-region?) (define lock-region? %lock-region?)
@ -59,16 +59,24 @@
(define lock-region:whence %lock-region:whence) (define lock-region:whence %lock-region:whence)
(define lock-region:start %lock-region:start) (define lock-region:start %lock-region:start)
(define lock-region:len %lock-region:len) (define lock-region:len %lock-region:len)
(define lock-region:pid %lock-region:pid) (define lock-region:proc %lock-region:proc)
(define set-lock-region:exclusive? set-%lock-region:exclusive?) (define set-lock-region:exclusive? set-%lock-region:exclusive?)
(define set-lock-region:whence set-%lock-region:whence) (define set-lock-region:whence set-%lock-region:whence)
(define set-lock-region:start set-%lock-region:start) (define set-lock-region:start set-%lock-region:start)
(define set-lock-region:len set-%lock-region:len) (define set-lock-region:len set-%lock-region:len)
(define set-lock-region:pid set-%lock-region:pid) (define set-lock-region:proc set-%lock-region:proc)
;;; Backwards compatibility for one or two releases.
(define lock-region:pid
(deprecated-proc (lambda (lr)
(cond ((lock-region:proc lr) => proc:pid)
(else #f)))
'lock-region:pid
"Use lock-region:proc instead."))
(define (make-lock-region exclusive? start len . maybe-whence) (define (make-lock-region exclusive? start len . maybe-whence)
(let ((whence (:optional maybe-whence seek/set))) (let ((whence (:optional maybe-whence seek/set)))
(make-%lock-region exclusive? start len whence 0))) (make-%lock-region exclusive? start len whence #f)))
;;; Internal middleman routine ;;; Internal middleman routine
@ -95,26 +103,31 @@
(define (lock-region/no-block fdes lock) (define (lock-region/no-block fdes lock)
(cond ((call-lock-region %set-lock fcntl/set-record-lock-noblock fdes lock) (cond ((call-lock-region %set-lock fcntl/set-record-lock-noblock fdes lock)
=> (lambda (errno) => (lambda (errno)
(cond ((= errno errno/again) #f) (cond ((or (= errno errno/again) (= errno errno/acces)) #f)
((= errno errno/intr) (lock-region/no-block fdes lock)) ((= errno errno/intr) (lock-region/no-block fdes lock))
(else (errno-error errno lock-region/no-block fdes lock))))) (else (errno-error errno lock-region/no-block fdes lock)))))
(else #t))) (else #t)))
;;; Return first lock overlapping LOCK; if none, return #f. ;;; Return first lock that conflicts w/LOCK; if none, return #f.
(define (get-lock-region fdes lock) (define (get-lock-region fdes lock)
(receive (err type whence start len pid) (receive (err type whence start len pid)
(call-lock-region %get-lock fcntl/get-record-lock fdes lock) (call-lock-region %get-lock fcntl/get-record-lock fdes lock)
(cond ((not err) (cond ((not err)
(and (not (= type lock/release)) (and (not (= type lock/release))
(make-%lock-region (= type lock/write) start len whence pid))) (make-%lock-region (= type lock/write) start len whence
(pid->proc pid 'create))))
((= err errno/intr) (get-lock-region fdes lock)) ((= err errno/intr) (get-lock-region fdes lock))
(else (errno-error err get-lock-region fdes lock))))) (else (errno-error err get-lock-region fdes lock)))))
(define-errno-syscall (unlock-region fdes lock) (define-errno-syscall (unlock-region fdes lock)
(lambda (fdes lock) (call-lock-region %set-lock lock/release fdes lock))) (lambda (fdes lock)
(%set-lock fdes fcntl/set-record-lock lock/release
(lock-region:whence lock)
(lock-region:start lock)
(lock-region:len lock))))
;;; Locks with dynamic extent -- with and without sugar ;;; Locks with dynamic extent -- with and without sugar