X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelStorable.lhs;h=b5f9089fb2a3b94ace4ce631a277884a3d526e1a;hb=32a895831dbc202fab780fdd8bee65be81e2d232;hp=343b36c8a9082b2f73b57943913b4e03e61fd9df;hpb=efa881239effd5ea4cb403c2c03ebb09fbdfd363;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelStorable.lhs b/ghc/lib/std/PrelStorable.lhs index 343b36c..b5f9089 100644 --- a/ghc/lib/std/PrelStorable.lhs +++ b/ghc/lib/std/PrelStorable.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: PrelStorable.lhs,v 1.1 2001/01/11 17:25:57 simonmar Exp $ +% $Id: PrelStorable.lhs,v 1.10 2001/10/03 13:57:42 simonmar Exp $ % % (c) The FFI task force, 2000 % @@ -7,6 +7,8 @@ A class for primitive marshaling \begin{code} +{-# OPTIONS -fno-implicit-prelude #-} + #include "MachDeps.h" module PrelStorable @@ -18,16 +20,17 @@ module PrelStorable peekByteOff, -- :: Ptr b -> Int -> IO a pokeByteOff, -- :: Ptr b -> Int -> a -> IO () peek, -- :: Ptr a -> IO a - poke) -- :: Ptr a -> a -> IO () + poke, -- :: Ptr a -> a -> IO () + destruct) -- :: Ptr a -> IO () ) where \end{code} \begin{code} -import Char ( chr, ord ) import Monad ( liftM ) #ifdef __GLASGOW_HASKELL__ import PrelStable ( StablePtr ) +import PrelNum import PrelInt import PrelWord import PrelCTypes @@ -35,6 +38,7 @@ import PrelCTypesISO import PrelStable import PrelPtr import PrelFloat +import PrelErr import PrelIOBase import PrelBase #endif @@ -64,6 +68,10 @@ class Storable a where peek :: Ptr a -> IO a poke :: Ptr a -> a -> IO () + -- free memory associated with the object + -- (except the object pointer itself) + destruct :: Ptr a -> IO () + -- circular default instances peekElemOff = peekElemOff_ undefined where peekElemOff_ :: a -> Ptr a -> Int -> IO a @@ -75,49 +83,48 @@ class Storable a where peek ptr = peekElemOff ptr 0 poke ptr = pokeElemOff ptr 0 + + destruct _ = return () \end{code} System-dependent, but rather obvious instances \begin{code} -instance Storable Char where - sizeOf _ = sizeOf (undefined::Word32) - alignment _ = alignment (undefined::Word32) - peekElemOff p i = liftM (chr . fromIntegral) $ peekElemOff (castPtr p::Ptr Word32) i - pokeElemOff p i x = pokeElemOff (castPtr p::Ptr Word32) i (fromIntegral (ord x)) - instance Storable Bool where sizeOf _ = sizeOf (undefined::CInt) alignment _ = alignment (undefined::CInt) peekElemOff p i = liftM (/= (0::CInt)) $ peekElemOff (castPtr p) i pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::CInt) -instance Storable (FunPtr a) where - sizeOf (FunPtr x) = sizeOf x - alignment (FunPtr x) = alignment x - peekElemOff p i = liftM FunPtr $ peekElemOff (castPtr p) i - pokeElemOff p i (FunPtr x) = pokeElemOff (castPtr p) i x +#define STORABLE(T,size,align,read,write) \ +instance Storable (T) where { \ + sizeOf _ = size; \ + alignment _ = align; \ + peekElemOff = read; \ + pokeElemOff = write } -#define STORABLE(T,size,align,read,write) \ -instance Storable (T) where { \ - sizeOf _ = size; \ - alignment _ = align; \ - peekElemOff a i = read a i; \ - pokeElemOff a i x = write a i x } +STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32, + readWideCharOffPtr,writeWideCharOffPtr) -STORABLE(Int,SIZEOF_INT,ALIGNMENT_INT, +STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT, readIntOffPtr,writeIntOffPtr) -STORABLE((Ptr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P, +STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD, + readWordOffPtr,writeWordOffPtr) + +STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR, readPtrOffPtr,writePtrOffPtr) -STORABLE((StablePtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P, +STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR, + readFunPtrOffPtr,writeFunPtrOffPtr) + +STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR, readStablePtrOffPtr,writeStablePtrOffPtr) -STORABLE(Float,SIZEOF_FLOAT,ALIGNMENT_FLOAT, +STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT, readFloatOffPtr,writeFloatOffPtr) -STORABLE(Double,SIZEOF_DOUBLE,ALIGNMENT_DOUBLE, +STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE, readDoubleOffPtr,writeDoubleOffPtr) STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8, @@ -162,6 +169,9 @@ NSTORABLE(CLong) NSTORABLE(CULong) NSTORABLE(CLLong) NSTORABLE(CULLong) +NSTORABLE(CFloat) +NSTORABLE(CDouble) +NSTORABLE(CLDouble) NSTORABLE(CPtrdiff) NSTORABLE(CSize) NSTORABLE(CWchar) @@ -175,128 +185,105 @@ Helper functions \begin{code} #ifdef __GLASGOW_HASKELL__ -readIntOffPtr :: Ptr Int -> Int -> IO Int -readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a) -readFloatOffPtr :: Ptr Float -> Int -> IO Float -readDoubleOffPtr :: Ptr Double -> Int -> IO Double -readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a) -readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8 -readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16 -readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32 -readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64 -readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8 -readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16 -readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32 -readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64 - +readWideCharOffPtr :: Ptr Char -> Int -> IO Char +readIntOffPtr :: Ptr Int -> Int -> IO Int +readWordOffPtr :: Ptr Word -> Int -> IO Word +readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a) +readFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> IO (FunPtr a) +readFloatOffPtr :: Ptr Float -> Int -> IO Float +readDoubleOffPtr :: Ptr Double -> Int -> IO Double +readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a) +readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8 +readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16 +readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32 +readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64 +readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8 +readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16 +readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32 +readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64 + +readWideCharOffPtr (Ptr a) (I# i) + = IO $ \s -> case readWideCharOffAddr# a i s of (# s2, x #) -> (# s2, C# x #) readIntOffPtr (Ptr a) (I# i) - = IO $ \s -> case readIntOffAddr# a i s of { (# s,x #) -> (# s, I# x #) } + = IO $ \s -> case readIntOffAddr# a i s of (# s2, x #) -> (# s2, I# x #) +readWordOffPtr (Ptr a) (I# i) + = IO $ \s -> case readWordOffAddr# a i s of (# s2, x #) -> (# s2, W# x #) readPtrOffPtr (Ptr a) (I# i) - = IO $ \s -> case readAddrOffAddr# a i s of { (# s,x #) -> (# s, Ptr x #) } + = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, Ptr x #) +readFunPtrOffPtr (Ptr a) (I# i) + = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, FunPtr x #) readFloatOffPtr (Ptr a) (I# i) - = IO $ \s -> case readFloatOffAddr# a i s of { (# s,x #) -> (# s, F# x #) } + = IO $ \s -> case readFloatOffAddr# a i s of (# s2, x #) -> (# s2, F# x #) readDoubleOffPtr (Ptr a) (I# i) - = IO $ \s -> case readDoubleOffAddr# a i s of { (# s,x #) -> (# s, D# x #) } + = IO $ \s -> case readDoubleOffAddr# a i s of (# s2, x #) -> (# s2, D# x #) readStablePtrOffPtr (Ptr a) (I# i) - = IO $ \s -> case readStablePtrOffAddr# a i s of { (# s,x #) -> (# s, StablePtr x #) } - + = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #) readInt8OffPtr (Ptr a) (I# i) - = IO $ \s -> case readInt8OffAddr# a i s of (# s, w #) -> (# s, I8# w #) - -readInt16OffPtr (Ptr a) (I# i) - = IO $ \s -> case readInt16OffAddr# a i s of (# s, w #) -> (# s, I16# w #) - -readInt32OffPtr (Ptr a) (I# i) - = IO $ \s -> case readInt32OffAddr# a i s of (# s, w #) -> (# s, I32# w #) - -#if WORD_SIZE_IN_BYTES == 8 -readInt64OffPtr (Ptr a) (I# i) - = IO $ \s -> case readIntOffAddr# a i s of (# s, w #) -> (# s, I64# w #) -#else -readInt64OffPtr (Ptr a) (I# i) - = IO $ \s -> case readInt64OffAddr# a i s of (# s, w #) -> (# s, I64# w #) -#endif - - -writeIntOffPtr :: Ptr Int -> Int -> Int -> IO () -writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO () -writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO () -writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO () -writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO () -writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO () -writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO () -writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO () -writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO () -writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO () -writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO () -writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO () -writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO () - -writeIntOffPtr (Ptr a#) (I# i#) (I# e#) = IO $ \ s# -> - case (writeIntOffAddr# a# i# e# s#) of s2# -> (# s2#, () #) - -writePtrOffPtr (Ptr a#) (I# i#) (Ptr e#) = IO $ \ s# -> - case (writeAddrOffAddr# a# i# e# s#) of s2# -> (# s2#, () #) - -writeFloatOffPtr (Ptr a#) (I# i#) (F# e#) = IO $ \ s# -> - case (writeFloatOffAddr# a# i# e# s#) of s2# -> (# s2#, () #) - -writeDoubleOffPtr (Ptr a#) (I# i#) (D# e#) = IO $ \ s# -> - case (writeDoubleOffAddr# a# i# e# s#) of s2# -> (# s2#, () #) - -writeStablePtrOffPtr (Ptr a#) (I# i#) (StablePtr e#) = IO $ \ s# -> - case (writeStablePtrOffAddr# a# i# e# s#) of s2# -> (# s2# , () #) - -writeInt8OffPtr (Ptr a#) (I# i#) (I8# w#) = IO $ \ s# -> - case (writeInt8OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) - -writeInt16OffPtr (Ptr a#) (I# i#) (I16# w#) = IO $ \ s# -> - case (writeInt16OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) - -writeInt32OffPtr (Ptr a#) (I# i#) (I32# w#) = IO $ \ s# -> - case (writeInt32OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) - -#if WORD_SIZE_IN_BYTES == 8 -writeInt64OffPtr (Ptr a#) (I# i#) (I64# w#) = IO $ \ s# -> - case (writeIntOffAddr# a# i# w# s#) of s2# -> (# s2#, () #) -#else -writeInt64OffPtr (Ptr a#) (I# i#) (I64# w#) = IO $ \ s# -> - case (writeInt64OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) -#endif - + = IO $ \s -> case readInt8OffAddr# a i s of (# s2, x #) -> (# s2, I8# x #) readWord8OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWord8OffAddr# a i s of (# s, w #) -> (# s, W8# w #) - + = IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# x #) +readInt16OffPtr (Ptr a) (I# i) + = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #) readWord16OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWord16OffAddr# a i s of (# s, w #) -> (# s, W16# w #) - + = IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# x #) +readInt32OffPtr (Ptr a) (I# i) + = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #) readWord32OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWord32OffAddr# a i s of (# s, w #) -> (# s, W32# w #) - -#if WORD_SIZE_IN_BYTES == 8 -readWord64OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWordOffAddr# a i s of (# s, w #) -> (# s, W64# w #) -#else + = IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #) +readInt64OffPtr (Ptr a) (I# i) + = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #) readWord64OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWord64OffAddr# a i s of (# s, w #) -> (# s, W64# w #) -#endif - -writeWord8OffPtr (Ptr a#) (I# i#) (W8# w#) = IO $ \ s# -> - case (writeWord8OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) - -writeWord16OffPtr (Ptr a#) (I# i#) (W16# w#) = IO $ \ s# -> - case (writeWord16OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) - -writeWord32OffPtr (Ptr a#) (I# i#) (W32# w#) = IO $ \ s# -> - case (writeWord32OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) - -#if WORD_SIZE_IN_BYTES == 8 -writeWord64OffPtr (Ptr a#) (I# i#) (W64# w#) = IO $ \ s# -> - case (writeWordOffAddr# a# i# w# s#) of s2# -> (# s2#, () #) -#else -writeWord64OffPtr (Ptr a#) (I# i#) (W64# w#) = IO $ \ s# -> - case (writeWord64OffAddr# a# i# w# s#) of s2# -> (# s2#, () #) -#endif + = IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# x #) + +writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO () +writeIntOffPtr :: Ptr Int -> Int -> Int -> IO () +writeWordOffPtr :: Ptr Word -> Int -> Word -> IO () +writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO () +writeFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> FunPtr a -> IO () +writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO () +writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO () +writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO () +writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO () +writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO () +writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO () +writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO () +writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO () +writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO () +writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO () +writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO () + +writeWideCharOffPtr (Ptr a) (I# i) (C# x) + = IO $ \s -> case writeWideCharOffAddr# a i x s of s2 -> (# s2, () #) +writeIntOffPtr (Ptr a) (I# i) (I# x) + = IO $ \s -> case writeIntOffAddr# a i x s of s2 -> (# s2, () #) +writeWordOffPtr (Ptr a) (I# i) (W# x) + = IO $ \s -> case writeWordOffAddr# a i x s of s2 -> (# s2, () #) +writePtrOffPtr (Ptr a) (I# i) (Ptr x) + = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #) +writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x) + = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #) +writeFloatOffPtr (Ptr a) (I# i) (F# x) + = IO $ \s -> case writeFloatOffAddr# a i x s of s2 -> (# s2, () #) +writeDoubleOffPtr (Ptr a) (I# i) (D# x) + = IO $ \s -> case writeDoubleOffAddr# a i x s of s2 -> (# s2, () #) +writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x) + = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #) +writeInt8OffPtr (Ptr a) (I# i) (I8# x) + = IO $ \s -> case writeInt8OffAddr# a i x s of s2 -> (# s2, () #) +writeWord8OffPtr (Ptr a) (I# i) (W8# x) + = IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #) +writeInt16OffPtr (Ptr a) (I# i) (I16# x) + = IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #) +writeWord16OffPtr (Ptr a) (I# i) (W16# x) + = IO $ \s -> case writeWord16OffAddr# a i x s of s2 -> (# s2, () #) +writeInt32OffPtr (Ptr a) (I# i) (I32# x) + = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #) +writeWord32OffPtr (Ptr a) (I# i) (W32# x) + = IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #) +writeInt64OffPtr (Ptr a) (I# i) (I64# x) + = IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #) +writeWord64OffPtr (Ptr a) (I# i) (W64# x) + = IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #) #endif /* __GLASGOW_HASKELL__ */ \end{code}