Move file locking into the RTS, fixing #629, #1109

File locking (of the Haskell 98 variety) was previously done using a
static table with linear search, which had two problems: the array had
a fixed size and was sometimes too small (#1109), and performance of
lockFile/unlockFile was suboptimal due to the linear search.
Also the algorithm failed to count readers as required by Haskell 98
(#629).

Now it's done using a hash table (provided by the RTS).  Furthermore I
avoided the extra fstat() for every open file by passing the dev_t and
ino_t into lockFile.  This and the improvements to the locking
algorithm result in a healthy 20% or so performance increase for
opening/closing files (see openFile008 test).

diff --git a/includes/FileLock.h b/includes/FileLock.h
new file mode 100644 (file)
index 0000000..3fc1a81
--- /dev/null
+++ b/includes/FileLock.h
@@ -0,0 +1,12 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2007
+ *
+ * File locking support as required by Haskell 98
+ *
+ * ---------------------------------------------------------------------------*/
+
+void initFileLocking(void);
+void freeFileLocking(void);
+int  lockFile(int fd, dev_t dev, ino_t ino, int for_writing);
+int  unlockFile(int fd);

diff --git a/rts/Hash.c b/rts/Hash.c
index 1d80640..033ccb3 100644 (file)
--- a/rts/Hash.c
+++ b/rts/Hash.c
@@ -35,9 +35,6 @@ struct hashlist {
 
 typedef struct hashlist HashList;
 
-typedef int HashFunction(HashTable *table, StgWord key);
-typedef int CompareFunction(StgWord key1, StgWord key2);
-
 struct hashtable {
     int split;             /* Next bucket to split when expanding */
     int max;               /* Max bucket of smaller table */
@@ -55,7 +52,7 @@ struct hashtable {
  * next bucket to be split, re-hash using the larger table.
  * -------------------------------------------------------------------------- */
 
-static int
+int
 hashWord(HashTable *table, StgWord key)
 {
     int bucket;
@@ -73,7 +70,7 @@ hashWord(HashTable *table, StgWord key)
     return bucket;
 }
 
-static int
+int
 hashStr(HashTable *table, char *key)
 {
     int h, bucket;
@@ -347,7 +344,7 @@ freeHashTable(HashTable *table, void (*freeDataFun)(void *) )
  * initializing all of the first segment's hash buckets to NULL.
  * -------------------------------------------------------------------------- */
 
-static HashTable *
+HashTable *
 allocHashTable_(HashFunction *hash, CompareFunction *compare)
 {
     HashTable *table;

diff --git a/rts/Hash.h b/rts/Hash.h
index fb83fdf..d16f9ae 100644 (file)
--- a/rts/Hash.h
+++ b/rts/Hash.h
@@ -32,6 +32,13 @@ HashTable * allocStrHashTable ( void );
 #define removeStrHashTable(table, key, data) \
    (removeHashTable(table, (StgWord)key, data))
 
+/* Hash tables for arbitrary keys */
+typedef int HashFunction(HashTable *table, StgWord key);
+typedef int CompareFunction(StgWord key1, StgWord key2);
+HashTable * allocHashTable_(HashFunction *hash, CompareFunction *compare);
+int hashWord(HashTable *table, StgWord key);
+int hashStr(HashTable *table, char *key);
+
 /* Freeing hash tables 
  */
 void freeHashTable ( HashTable *table, void (*freeDataFun)(void *) );

diff --git a/rts/Linker.c b/rts/Linker.c
index 81709f7..7793801 100644 (file)
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -174,6 +174,8 @@ typedef struct _RtsSymbolVal {
 
 #if !defined (mingw32_HOST_OS)
 #define RTS_POSIX_ONLY_SYMBOLS                  \
+      Sym(lockFile)                             \
+      Sym(unlockFile)                           \
       SymX(signal_handlers)                    \
       SymX(stg_sig_install)                    \
       Sym(nocldstop)

diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index cdb45c6..4f84468 100644 (file)
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -33,6 +33,7 @@
 #include "RtsTypeable.h"
 #include "Stable.h"
 #include "Hpc.h"
+#include "FileLock.h"
 
 #if defined(RTS_GTK_FRONTPANEL)
 #include "FrontPanel.h"
@@ -238,6 +239,11 @@ hs_init(int *argc, char **argv[])
     /* initialise the shared Typeable store */
     initTypeableStore();
 
+    /* initialise file locking, if necessary */
+#if !defined(mingw32_HOST_OS)    
+    initFileLocking();
+#endif
+
 #if defined(DEBUG)
     /* initialise thread label table (tso->char*) */
     initThreadLabelTable();
@@ -462,6 +468,11 @@ hs_exit_(rtsBool wait_foreign)
     /* free shared Typeable store */
     exitTypeableStore();
 
+    /* free file locking tables, if necessary */
+#if !defined(mingw32_HOST_OS)    
+    freeFileLocking();
+#endif
+
     /* free the stable pointer table */
     exitStablePtrTable();
 

diff --git a/rts/posix/FileLock.c b/rts/posix/FileLock.c
new file mode 100644 (file)
index 0000000..436d8c9
--- /dev/null
+++ b/rts/posix/FileLock.c
@@ -0,0 +1,121 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2007
+ *
+ * File locking support as required by Haskell 98
+ *
+ * ---------------------------------------------------------------------------*/
+ 
+#include "Rts.h"
+#include "Hash.h"
+#include "FileLock.h"
+#include "RtsUtils.h"
+
+#include <unistd.h>
+#include <sys/stat.h>
+#include <errno.h>
+
+typedef struct {
+    dev_t device;
+    ino_t inode;
+    int   readers; // >0 : readers,  <0 : writers
+} Lock;
+
+// Two hash tables.  The first maps objects (device/inode pairs) to
+// Lock objects containing the number of active readers or writers.  The
+// second maps file descriptors to lock objects, so that we can unlock
+// by FD without needing to fstat() again.
+static HashTable *obj_hash;
+static HashTable *fd_hash;
+
+static int cmpLocks(StgWord w1, StgWord w2)
+{
+    Lock *l1 = (Lock *)w1;
+    Lock *l2 = (Lock *)w2;
+    return (l1->device == l2->device && l1->inode == l2->inode);
+}
+
+static int hashLock(HashTable *table, StgWord w)
+{
+    Lock *l = (Lock *)w;
+    // Just xor the dev_t with the ino_t, hope this is good enough.
+    return hashWord(table, (StgWord)l->inode ^ (StgWord)l->device);
+}
+
+void
+initFileLocking(void)
+{
+    obj_hash = allocHashTable_(hashLock, cmpLocks);
+    fd_hash  = allocHashTable(); /* ordinary word-based table */
+}
+
+static void
+freeLock(void *lock)
+{
+    stgFree(lock);
+}
+
+void
+freeFileLocking(void)
+{
+    freeHashTable(obj_hash, freeLock);
+    freeHashTable(fd_hash,  NULL);
+}
+
+int
+lockFile(int fd, dev_t dev, ino_t ino, int for_writing)
+{
+    Lock key, *lock;
+
+    key.device = dev;
+    key.inode  = ino;
+
+    lock = lookupHashTable(obj_hash, (StgWord)&key);
+
+    if (lock == NULL)
+    {
+        lock = stgMallocBytes(sizeof(Lock), "lockFile");
+        lock->device = dev;
+        lock->inode  = ino;
+        lock->readers = for_writing ? -1 : 1;
+        insertHashTable(obj_hash, (StgWord)lock, (void *)lock);
+        insertHashTable(fd_hash, fd, lock);
+        return 0;
+    }
+    else
+    {
+        // single-writer/multi-reader locking:
+        if (for_writing || lock->readers < 0) {
+            return -1;
+        }
+        lock->readers++;
+        return 0;
+    }
+}
+
+int
+unlockFile(int fd)
+{
+    Lock *lock;
+
+    lock = lookupHashTable(fd_hash, fd);
+    if (lock == NULL) {
+        // errorBelch("unlockFile: fd %d not found", fd); 
+        // This is normal: we didn't know when calling unlockFile
+        // whether this FD referred to a locked file or not.
+        return 1;
+    }
+
+    if (lock->readers < 0) {
+        lock->readers++;
+    } else {
+        lock->readers--;
+    }
+
+    if (lock->readers == 0) {
+        removeHashTable(obj_hash, (StgWord)lock, NULL);
+        stgFree(lock);
+    }
+    removeHashTable(fd_hash, fd, NULL);
+    return 0;
+}