Add shared Typeable support

[ghc-hetmet.git] / rts / Typeable.c

diff --git a/rts/Typeable.c b/rts/Typeable.c
new file mode 100644 (file)
index 0000000..e07c764
--- /dev/null
+++ b/rts/Typeable.c
@@ -0,0 +1,48 @@
+#include "RtsTypeable.h"
+#include "Rts.h"
+\r
+static StgPtr typeableStore = 0;\r
+#ifdef THREADED_RTS\r
+Mutex typeableStoreLock;\r
+#endif\r
+\r
+\r
+void\r
+initTypeableStore()\r
+{\r
+    typeableStore=0;\r
+#ifdef THREADED_RTS\r
+    initMutex(&typeableStoreLock);\r
+#endif\r
+}\r
+\r
+void\r
+exitTypeableStore()\r
+{\r
+#ifdef THREADED_RTS\r
+    /* TODO: Free Mutex! */\r
+#endif\r
+    if(typeableStore!=0) {\r
+        freeStablePtr((StgStablePtr)typeableStore);\r
+        typeableStore=0;\r
+    }\r
+}\r
+\r
+StgPtr\r
+getOrSetTypeableStore(StgPtr ptr)\r
+{\r
+    StgPtr ret = typeableStore;\r
+    if(ret==0) {\r
+#ifdef THREADED_RTS\r
+        ACQUIRE_LOCK(&typeableStoreLock);\r
+        ret=typeableStore;\r
+        if(ret==0) {\r
+#endif\r
+            typeableStore = ret = ptr;\r
+#ifdef THREADED_RTS\r
+        }\r
+        RELEASE_LOCK(&typeableStoreLock);\r
+#endif\r
+    }\r
+    return ret;\r
+}\r