ghc/lib/std/PrelMarshalAlloc.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelMarshalAlloc.lhs,v 1.2 2001/05/18 16:54:05 simonmar Exp $
   3 %
   4 % (c) The FFI task force, 2000
   5 %
   6
   7 Marshalling support: basic routines for memory allocation
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module PrelMarshalAlloc (
  13   malloc,       -- :: Storable a =>        IO (Ptr a)
  14   mallocBytes,  -- ::               Int -> IO (Ptr a)
  15
  16   alloca,       -- :: Storable a =>        (Ptr a -> IO b) -> IO b
  17   allocaBytes,  -- ::               Int -> (Ptr a -> IO b) -> IO b
  18
  19   reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a)
  20
  21   free          -- :: Ptr a -> IO ()
  22 ) where
  23
  24 #ifdef __GLASGOW_HASKELL__
  25 import PrelException    ( bracket )
  26 import PrelPtr          ( Ptr, nullPtr )
  27 import PrelStorable     ( Storable(sizeOf) )
  28 import PrelCTypesISO    ( CSize )
  29 import PrelIOBase
  30 import PrelMaybe
  31 import PrelReal
  32 import PrelNum
  33 import PrelErr
  34 import PrelBase
  35 #endif
  36
  37
  38 -- exported functions
  39 -- ------------------
  40
  41 -- allocate space for storable type
  42 --
  43 malloc :: Storable a => IO (Ptr a)
  44 malloc  = doMalloc undefined
  45   where
  46     doMalloc       :: Storable a => a -> IO (Ptr a)
  47     doMalloc dummy  = mallocBytes (sizeOf dummy)
  48
  49 -- allocate given number of bytes of storage
  50 --
  51 mallocBytes      :: Int -> IO (Ptr a)
  52 mallocBytes size  = failWhenNULL "malloc" (_malloc (fromIntegral size))
  53
  54 -- temporarily allocate space for a storable type
  55 --
  56 -- * the pointer passed as an argument to the function must *not* escape from
  57 --   this function; in other words, in `alloca f' the allocated storage must
  58 --   not be used after `f' returns
  59 --
  60 alloca :: Storable a => (Ptr a -> IO b) -> IO b
  61 alloca  = doAlloca undefined
  62   where
  63     doAlloca       :: Storable a => a -> (Ptr a -> IO b) -> IO b
  64     doAlloca dummy  = allocaBytes (sizeOf dummy)
  65
  66 -- temporarily allocate the given number of bytes of storage
  67 --
  68 -- * the pointer passed as an argument to the function must *not* escape from
  69 --   this function; in other words, in `allocaBytes n f' the allocated storage
  70 --   must not be used after `f' returns
  71 --
  72 allocaBytes      :: Int -> (Ptr a -> IO b) -> IO b
  73 allocaBytes size  = bracket (mallocBytes size) free
  74
  75 -- adjust a malloc'ed storage area to the given size
  76 --
  77 reallocBytes          :: Ptr a -> Int -> IO (Ptr a)
  78 reallocBytes ptr size  =
  79   failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
  80
  81 -- free malloc'ed storage
  82 --
  83 free :: Ptr a -> IO ()
  84 free  = _free
  85
  86
  87 -- auxilliary routines
  88 -- -------------------
  89
  90 -- asserts that the pointer returned from the action in the second argument is
  91 -- non-null
  92 --
  93 failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
  94 failWhenNULL name f = do
  95    addr <- f
  96    if addr == nullPtr
  97 #ifdef __GLASGOW_HASKELL__
  98       then ioException (IOError Nothing ResourceExhausted name
  99                                         "out of memory" Nothing)
 100 #else
 101       then ioError (userError (name++": out of memory"))
 102 #endif
 103       else return addr
 104
 105 -- basic C routines needed for memory allocation
 106 --
 107 foreign import "malloc"  unsafe _malloc  ::          CSize -> IO (Ptr a)
 108 foreign import "realloc" unsafe _realloc :: Ptr a -> CSize -> IO (Ptr a)
 109 foreign import "free"    unsafe _free    :: Ptr a -> IO ()
 110
 111 \end{code}