Added dot-locking.

scsh/dot-locking.scm

@@ -0,0 +1,50 @@
+(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))))))))

scsh/scsh-interfaces.scm

@@ -1157,4 +1157,5 @@
 
 (define-interface locks-interface
   (export obtain-lock
-	  release-lock))
+	  release-lock
+	  (with-lock :syntax)))

scsh/scsh-package.scm

@@ -382,6 +382,7 @@
 ;	dbm
 	awk-package
 	field-reader-package
+	dot-locking
 	scheme)
 
   (access scsh-top-package)
@@ -445,3 +446,11 @@
 	  threads
 	  threads-internal)
   (files threads))
+
+(define-structure dot-locking locks-interface
+  (open scsh
+	scheme
+	handle
+	threads) ; sleep
+  (files dot-locking)) 
+