From: simonmar <unknown>
Date: Wed, 8 Aug 2001 14:36:14 +0000 (+0000)
Subject: [project @ 2001-08-08 14:36:14 by simonmar]
X-Git-Tag: Approximately_9120_patches~1304
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=55e4af3c209d144f90e88b3a1dc7c6cf148b2176;p=ghc-hetmet.git

[project @ 2001-08-08 14:36:14 by simonmar]
Define allocaBytes in terms of the new pinned ByteArray primitives.
This version is over 6 times faster than the old version using
malloc/free.
---

diff --git a/ghc/lib/std/PrelMarshalAlloc.lhs b/ghc/lib/std/PrelMarshalAlloc.lhs
index 12aa164..055b9a8 100644
--- a/ghc/lib/std/PrelMarshalAlloc.lhs
+++ b/ghc/lib/std/PrelMarshalAlloc.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelMarshalAlloc.lhs,v 1.2 2001/05/18 16:54:05 simonmar Exp $
+% $Id: PrelMarshalAlloc.lhs,v 1.3 2001/08/08 14:36:14 simonmar Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -23,7 +23,7 @@ module PrelMarshalAlloc (
 
 #ifdef __GLASGOW_HASKELL__
 import PrelException 	( bracket )
-import PrelPtr	 	( Ptr, nullPtr )
+import PrelPtr	 	( Ptr(..), nullPtr )
 import PrelStorable  	( Storable(sizeOf) )
 import PrelCTypesISO 	( CSize )
 import PrelIOBase
@@ -69,8 +69,21 @@ alloca  = doAlloca undefined
 --   this function; in other words, in `allocaBytes n f' the allocated storage
 --   must not be used after `f' returns
 --
+#ifdef __GLASGOW_HASKELL__
+allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
+allocaBytes (I# size) action = IO $ \ s ->
+     case newPinnedByteArray# size s      of { (# s, mbarr# #) ->
+     case unsafeFreezeByteArray# mbarr# s of { (# s, barr#  #) ->
+     let addr = Ptr (byteArrayContents# barr#) in
+     case action addr    of { IO action ->
+     case action s       of { (# s, r #) ->
+     case touch# barr# s of { s ->
+     (# s, r #)
+  }}}}}
+#else
 allocaBytes      :: Int -> (Ptr a -> IO b) -> IO b
 allocaBytes size  = bracket (mallocBytes size) free
+#endif
 
 -- adjust a malloc'ed storage area to the given size
 --