[add support for 'Coerce' grin primitive, add atomic allocs in grin.
John Meacham <john@repetae.net>**20120207063202
 Ignore-this: 64eab2e8901db764df62b6fcd471b6b7
] hunk ./lib/base/Foreign/ForeignPtr.hs 15
+import Jhc.IO
hunk ./lib/base/Foreign/ForeignPtr.hs 62
-touchForeignPtr _ = return ()
+touchForeignPtr x = fromUIO_ (touch_ x)
hunk ./lib/base/Foreign/ForeignPtr.hs 64
---foreign import primitive "touch_" :: ForeignPtr a ->
+foreign import primitive touch_ :: ForeignPtr a -> UIO_
addfile ./rts/rts_constants.h
hunk ./rts/rts_constants.h 1
+#ifndef RTS_CONSTANTS_H
+#define RTS_CONSTANTS_H
+/* these constants are shared between jhc-prim and the rts. */
+
+// Normal memory block.
+#define SLAB_FLAG_NONE      0
+
+// Each element has a finalizer-list as its second word.
+#define SLAB_FLAG_FINALIZER 1
+
+// In addition to whatever other finalization is done, 'free' should be called
+// on the first word of each entry.
+#define SLAB_FLAG_FREE      2
+
+// Finalizers should be delayed until entire slab is freed up and individually
+// freed members need not be kept track of.
+#define SLAB_FLAG_DELAY     4
+
+#endif
hunk ./rts/slub.c 52
+        unsigned char flags;
hunk ./rts/slub.c 279
+        sc->pi.flags = FLAG_NONE;
hunk ./src/C/FromGrin2.hs 441
-convertBody (BaseOp (StoreNode b)  [n@NodeC {}])  = newNode region_heap (bool b wptr_t sptr_t) n >>= \(x,y) -> simpleRet y >>= \v -> return (x & v)
-convertBody (BaseOp (StoreNode b)  [n@NodeC {},region]) = newNode region (bool b wptr_t sptr_t) n >>= \(x,y) -> simpleRet y >>= \v -> return (x & v)
+convertBody (BaseOp (StoreNode b) [n@NodeC {}]) = newNode region_heap (bool b wptr_t sptr_t) n >>= \(x,y) -> simpleRet y >>= \v -> return (x & v)
+convertBody (BaseOp (StoreNode b) [n@NodeC {},region]) = newNode region (bool b wptr_t sptr_t) n >>= \(x,y) -> simpleRet y >>= \v -> return (x & v)
hunk ./src/C/FromGrin2.hs 481
---convertBody (Update (Index base off) z) | getType base == TyPtr tyINode = do
---    base <- convertVal base
---    off <- convertVal off
---    z' <- convertVal z
---    return $ indexArray base off =* z'
hunk ./src/C/FromGrin2.hs 485
-
+convertBody (BaseOp (Coerce ty) [v])  = do
+    v <- convertVal v
+    ty <- convertType ty
+    simpleRet $ cast ty v
hunk ./src/C/FromGrin2.hs 605
+convertExp Alloc { expValue = v, expCount = c, expRegion = r } |
+    r == region_atomic_heap, TyPrim Op.bits_ptr == getType v  = do
+        v' <- convertVal v
+        c' <- convertVal c
+        tmp <- newVar (ptrType uintptr_t)
+        let malloc = tmp =* jhc_malloc_atomic (operator "*" (sizeof uintptr_t) c')
+        fill <- case v of
+            ValUnknown _ -> return mempty
+            _ -> do
+                i <- newVar (basicType "int")
+                return $ forLoop i (expressionRaw "0") c' $ indexArray tmp i =* v'
+        return (malloc `mappend` fill, tmp)
hunk ./src/C/FromGrin2.hs 908
+
+jhc_malloc_atomic sz | fopts FO.Jgc = functionCall (name "gc_alloc") [v_gc,nullPtr, tbsize sz, toExpression (0::Int)]
+                     | otherwise = jhc_malloc nullPtr (0::Int) sz
+
hunk ./src/C/FromGrin2.hs 953
+uintptr_t = basicGCType "uintptr_t"
hunk ./src/Grin/FromE.hs 68
-    (tc_MutArray__,TyPtr tyINode)
+    (tc_MutArray__,TyPtr tyINode),
+    (tc_Bang_,tyDNode)
hunk ./src/Grin/FromE.hs 427
+        -- rts
+        f "toBang_" (args -> [x]) = do
+            return $ gEval x
+        f "fromBang_" [x] = do
+            return (BaseOp Demote $ args [x])
+        f "mallocHeapWords" [w,_] = do
+            let [c] = args [w]
+            v <- newPrimVar (TyPtr (TyPrim Op.bits_ptr))
+            return $ Alloc { expValue = ValUnknown (TyPrim Op.bits_ptr),
+                expCount = c, expRegion = region_atomic_heap, expInfo = mempty } :>>= [v] :-> BaseOp (Coerce tyDNode) [v]
hunk ./src/Grin/Grin.hs 107
+    | Coerce Ty             -- coerce one type to another, danger zone. This is for reflection/rts and not for integral conversions.
hunk ./src/Grin/Grin.hs 453
+    getType (BaseOp (Coerce t) _) = [t]
hunk ./src/Grin/Show.hs 75
+prettyExp vl (BaseOp Coerce {} [v]) = vl <> keyword "coerce" <+> prettyVal v
hunk ./src/Grin/Val.hs 11
+    region_atomic_heap,
hunk ./src/Grin/Val.hs 36
+-- This allocates data on the atomic heap.
+region_atomic_heap  = Item (toAtom "atomicHeap") TyRegion
hunk ./src/Ho/Binary.hs 22
-current_version = 8
+current_version = 9