X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FForeignPtr.hs;h=dbf6c2c180597ed260f7710205d286be3a3ff1fa;hb=be2750a0a11b919fb03cc070074e430f88bdfa90;hp=3cd760930f5b97ee6a3ddf4abcb4fd76c8496877;hpb=47954c351109f0868c716e4c9552b973ce7a53aa;p=ghc-base.git diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs index 3cd7609..dbf6c2c 100644 --- a/GHC/ForeignPtr.hs +++ b/GHC/ForeignPtr.hs @@ -1,5 +1,12 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# LANGUAGE CPP + , NoImplicitPrelude + , BangPatterns + , MagicHash + , UnboxedTuples + #-} {-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.ForeignPtr @@ -42,7 +49,6 @@ import Data.Typeable import GHC.Show import GHC.List ( null ) import GHC.Base --- import GHC.IO import GHC.IORef import GHC.STRef ( STRef(..) ) import GHC.Ptr ( Ptr(..), FunPtr(..) ) @@ -100,7 +106,7 @@ instance Show (ForeignPtr a) where showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f) --- |A Finalizer is represented as a pointer to a foreign function that, at +-- |A finalizer is represented as a pointer to a foreign function that, at -- finalisation time, gets as an argument a plain pointer variant of the -- foreign pointer that the finalizer is associated with. -- @@ -150,7 +156,9 @@ mallocForeignPtr :: Storable a => IO (ForeignPtr a) -- mallocForeignPtr = doMalloc undefined where doMalloc :: Storable b => b -> IO (ForeignPtr b) - doMalloc a = do + doMalloc a + | I# size < 0 = error "mallocForeignPtr: size must be >= 0" + | otherwise = do r <- newIORef (NoFinalizers, []) IO $ \s -> case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) -> @@ -163,6 +171,8 @@ mallocForeignPtr = doMalloc undefined -- | This function is similar to 'mallocForeignPtr', except that the -- size of the memory required is given explicitly as a number of bytes. mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) +mallocForeignPtrBytes size | size < 0 = + error "mallocForeignPtrBytes: size must be >= 0" mallocForeignPtrBytes (I# size) = do r <- newIORef (NoFinalizers, []) IO $ \s -> @@ -187,7 +197,9 @@ mallocForeignPtrBytes (I# size) = do mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a) mallocPlainForeignPtr = doMalloc undefined where doMalloc :: Storable b => b -> IO (ForeignPtr b) - doMalloc a = IO $ \s -> + doMalloc a + | I# size < 0 = error "mallocForeignPtr: size must be >= 0" + | otherwise = IO $ \s -> case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) -> (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) (PlainPtr mbarr#) #) @@ -200,6 +212,8 @@ mallocPlainForeignPtr = doMalloc undefined -- finalizer is used. Attempts to add a finalizer will cause an -- exception to be thrown. mallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a) +mallocPlainForeignPtrBytes size | size < 0 = + error "mallocPlainForeignPtrBytes: size must be >= 0" mallocPlainForeignPtrBytes (I# size) = IO $ \s -> case newPinnedByteArray# size s of { (# s', mbarr# #) -> (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) @@ -224,7 +238,7 @@ addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of addForeignPtrFinalizerEnv :: FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO () --- ^ like 'addForeignPtrFinalizerEnv' but allows the finalizer to be +-- ^ Like 'addForeignPtrFinalizerEnv' but allows the finalizer to be -- passed an additional environment parameter to be passed to the -- finalizer. The environment passed to the finalizer is fixed by the -- second argument to 'addForeignPtrFinalizerEnv' @@ -349,7 +363,7 @@ unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a -- To avoid subtle coding errors, hand written marshalling code -- should preferably use 'Foreign.ForeignPtr.withForeignPtr' rather -- than combinations of 'unsafeForeignPtrToPtr' and --- 'touchForeignPtr'. However, the later routines +-- 'touchForeignPtr'. However, the latter routines -- are occasionally preferred in tool generated marshalling code. unsafeForeignPtrToPtr (ForeignPtr fo _) = Ptr fo