diff --git a/scsh/flock.scm b/scsh/flock.scm index 869d0c3..c45133b 100644 --- a/scsh/flock.scm +++ b/scsh/flock.scm @@ -51,7 +51,7 @@ start ; integer len ; Positive integer or #f whence ; seek/set, seek/delta, or seek/end. - pid ; Process holding lock + proc ; Process holding lock ) (define lock-region? %lock-region?) @@ -59,16 +59,24 @@ (define lock-region:whence %lock-region:whence) (define lock-region:start %lock-region:start) (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:whence set-%lock-region:whence) (define set-lock-region:start set-%lock-region:start) (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) (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 @@ -95,26 +103,31 @@ (define (lock-region/no-block fdes lock) (cond ((call-lock-region %set-lock fcntl/set-record-lock-noblock fdes lock) => (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)) (else (errno-error errno lock-region/no-block fdes lock))))) (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) (receive (err type whence start len pid) (call-lock-region %get-lock fcntl/get-record-lock fdes lock) (cond ((not err) (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)) (else (errno-error err get-lock-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