summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--includes/FileLock.h12
-rw-r--r--rts/Hash.c9
-rw-r--r--rts/Hash.h7
-rw-r--r--rts/Linker.c2
-rw-r--r--rts/RtsStartup.c11
-rw-r--r--rts/posix/FileLock.c121
6 files changed, 156 insertions, 6 deletions
diff --git a/includes/FileLock.h b/includes/FileLock.h
new file mode 100644
index 0000000000..3fc1a81aec
--- /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 1d80640c4a..033ccb3e73 100644
--- 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 fb83fdfa9e..d16f9ae9c1 100644
--- 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 81709f7819..7793801325 100644
--- 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 cdb45c60f2..4f84468b0a 100644
--- 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
index 0000000000..436d8c9da5
--- /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;
+}