Update of /cvsroot/scsh/scsh-0.6/scsh
In directory slayer.i.sourceforge.net:/tmp/cvs-serv4255
Modified Files:
scsh-interfaces.scm scsh-package.scm
Added Files:
dot-locking.scm
Log Message:
Added dot-locking.
--- NEW FILE ---
(define (make-lockname filename)
(string-append filename ".lock"))
(define (create-temp filename)
(create-temp-file filename))
(define (maybe-obtain-lock tempname filename)
(let ((port (open-file tempname (bitwise-ior open/write
open/create
open/exclusive))))
(close port)
(with-errno-handler
((errno packet)
((errno/exist)
(delete-file tempname)
#f))
(create-hard-link tempname (make-lockname filename))
(delete-file tempname)
#t)))
(define (release-lock filename)
(with-errno-handler
((errno packet)
(else #f))
(delete-file (make-lockname filename))
#t))
(define (obtain-lock filename)
(let ((tempname (create-temp filename)))
(delete-file tempname)
(let loop ()
(or (maybe-obtain-lock tempname filename)
(begin (sleep 1000)
(loop))))))
(define-syntax with-lock
(syntax-rules
()
((with-lock filename body ...)
(with-handler
(lambda (condition more)
(release-lock filename)
(more))
(lambda ()
(obtain-lock filename)
(call-with-values (lambda ()
body ...)
(lambda a
(release-lock filename)
(apply values a))))))))
Index: scsh-interfaces.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-interfaces.scm,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -r1.10 -r1.11
*** scsh-interfaces.scm 2000/09/24 20:51:04 1.10
--- scsh-interfaces.scm 2000/09/27 11:53:21 1.11
***************
*** 1158,1160 ****
(define-interface locks-interface
(export obtain-lock
! release-lock))
\ No newline at end of file
--- 1158,1161 ----
(define-interface locks-interface
(export obtain-lock
! release-lock
! (with-lock :syntax)))
\ No newline at end of file
Index: scsh-package.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-package.scm,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -r1.12 -r1.13
*** scsh-package.scm 2000/08/28 12:51:22 1.12
--- scsh-package.scm 2000/09/27 11:53:21 1.13
***************
*** 383,386 ****
--- 383,387 ----
awk-package
field-reader-package
+ dot-locking
scheme)
***************
*** 446,447 ****
--- 447,456 ----
threads-internal)
(files threads))
+
+ (define-structure dot-locking locks-interface
+ (open scsh
+ scheme
+ handle
+ threads) ; sleep
+ (files dot-locking))
+
\ No newline at end of file
|