[plt-scheme] File Locks

From: Matt Jadud (mcj4 at kent.ac.uk)
Date: Thu Aug 11 04:10:32 EDT 2005

Another solution might be to use channels. They provide blocking 
communications between threads. Whenever you want to write to a file, 
write to its channel instead; hide the synchronization in the fact that 
the channel write (from your worker thread to your logger thread) will 
block. In other words, make your concurrency primitive implicit instead 
of explicit (semaphore, spinlock, etc.).

You may have already looked at channels and decided they're not 
appropriate for your app; if so, this is noise. If not, it's food for 
thought.

M

(define-syntax forever
   (lambda (stx)
     (syntax-case stx ()
       [(forever bodies ...)
        #`(let loop ()
            #,@(syntax->list (syntax (bodies ...)))
            (loop))])))

;; The channel-get will block until someone tries to
;; write to the channel "ch". Then, the "display" takes place,
;; and we loop back to the block.
(define (write-to-file ch op)
   (forever
    (display (channel-get ch) op)))

;; Sleep for some random amount of time, and then write to the
;; channel. Rinse and repeat.
(define (a-thread ch n content)
   (thread
    (lambda ()
      (forever
       (sleep (random n))
         (channel-put
          ch (format "Thread (random ~a) [~a -> ~a]: ~a~n" n 
(current-seconds) content))))))

;; Sleep for some random amount of time, and then spawn
;; a thread; immediately begin sleeping again. The spawned
;; child thread will wait until it can write to the file and
;; then die. You could also, I suspect, use asychronous channels
;; at this point. Also, I doubt this guarantees write order;
;; in fact, both of these logging mechanisms are probably
;; completely non-deterministic; you'd have to look at
;; how channel.ss and the underlying mechanisms are implemented.
(define (a-non-blocking-thread ch n content)
   (thread
    (lambda ()
      (forever
       (sleep (random n))
         (thread
          (lambda ()
            (channel-put
             ch (format "Thread (random ~a) [~a -> ~a]: ~a~n" n 
(current-seconds) content))))))))

(define (test-threads thread-maker file)
   (let ([op (open-output-file file 'replace)]
         [ch (make-channel)])
     (let ([wr (thread (lambda () (write-to-file ch op)))]
           [t1 (thread-maker ch 5 "Foo Foo")]
           [t2 (thread-maker ch 15 "Bar Bar")]
           [t3 (thread-maker ch 20 "Gee Gee")])
       (sleep 60)
       (for-each kill-thread (list wr t1 t2 t3))
       (close-output-port op)
       )))

;; Each thread's world stops while attempting to write
;;(test-threads a-thread "~/Desktop/testfile")

;; Each thread spawns a thread just to do the write, allowing
;;   computation to continue.
;;(test-threads a-non-blocking-thread "~/Desktop/testfile2")



Matthew Flatt wrote:
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme
> 
> At Wed, 10 Aug 2005 17:55:33 -0400, Andrey Skylar wrote:
> 
>>Does scheme's with-out-put-to-file and with-input-from-file functions
>>lock the files or in some other way prevent from two threads writing
>>at the same time or writing and reading at the same time? 
> 
> 
> No.
> 
> 
>>If not, how may I go about making sure it doesn't happen?
> 
> 
> The preference-writing function provided by the "file.ss" library
> implements a lock as a separate file. The lock is held when the file
> exists, and it's not held when the file doesn't exist. The file works
> as a lock because `open-output-file' (without 'truncate, 'append, etc.)
> creates a file atomically, and it fails with a specific type of
> exception when the file already exists.
> 
> Matthew
> 



Posted on the users mailing list.