{-# OPTIONS -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
---
+-- |
-- Module : Foreign.Marshal.Alloc
-- Copyright : (c) The FFI task force 2001
-- License : BSD-style (see the file libraries/core/LICENSE)
-- Stability : provisional
-- Portability : portable
--
--- $Id: Alloc.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
---
-- Marshalling support: basic routines for memory allocation
--
-----------------------------------------------------------------------------
import Data.Maybe
import Foreign.Ptr ( Ptr, nullPtr )
import Foreign.C.TypesISO ( CSize )
+import Foreign.Storable ( Storable(sizeOf) )
#ifdef __GLASGOW_HASKELL__
-import GHC.Exception ( bracket )
-import GHC.Storable ( Storable(sizeOf) )
+import GHC.Exception ( bracket )
import GHC.IOBase
import GHC.Real
+import GHC.Ptr
import GHC.Err
import GHC.Base
#endif
-- 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
--
-- basic C routines needed for memory allocation
--
-foreign import "malloc" unsafe _malloc :: CSize -> IO (Ptr a)
-foreign import "realloc" unsafe _realloc :: Ptr a -> CSize -> IO (Ptr a)
-foreign import "free" unsafe _free :: Ptr a -> IO ()
+foreign import ccall unsafe "malloc" _malloc :: CSize -> IO (Ptr a)
+foreign import ccall unsafe "realloc" _realloc :: Ptr a -> CSize -> IO (Ptr a)
+foreign import ccall unsafe "free" _free :: Ptr a -> IO ()