GHC/Storable.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: Storable.lhs,v 1.2 2001/07/31 13:10:01 simonmar Exp $
   3 %
   4 % (c) The FFI task force, 2000
   5 %
   6
   7 A class for primitive marshaling
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude -monly-3-regs #-}
  11
  12 #include "MachDeps.h"
  13
  14 module GHC.Storable
  15         ( Storable(
  16              sizeOf,         -- :: a -> Int
  17              alignment,      -- :: a -> Int
  18              peekElemOff,    -- :: Ptr a -> Int      -> IO a
  19              pokeElemOff,    -- :: Ptr a -> Int -> a -> IO ()
  20              peekByteOff,    -- :: Ptr b -> Int      -> IO a
  21              pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()
  22              peek,           -- :: Ptr a             -> IO a
  23              poke,           -- :: Ptr a        -> a -> IO ()
  24              destruct)       -- :: Ptr a             -> IO ()
  25         ) where
  26 \end{code}
  27
  28 \begin{code}
  29 import Control.Monad            ( liftM )
  30 import Foreign.C.Types
  31 import Foreign.C.TypesISO
  32
  33 #ifdef __GLASGOW_HASKELL__
  34 import GHC.Stable       ( StablePtr )
  35 import GHC.Num
  36 import GHC.Int
  37 import GHC.Word
  38 import GHC.Stable
  39 import Foreign.Ptr
  40 import GHC.Float
  41 import GHC.Err
  42 import GHC.IOBase
  43 import GHC.Base
  44 #endif
  45 \end{code}
  46
  47 Primitive marshaling
  48
  49 Minimal complete definition: sizeOf, alignment, and one definition
  50 in each of the peek/poke families.
  51
  52 \begin{code}
  53 class Storable a where
  54
  55    -- sizeOf/alignment *never* use their first argument
  56    sizeOf      :: a -> Int
  57    alignment   :: a -> Int
  58
  59    -- replacement for read-/write???OffAddr
  60    peekElemOff :: Ptr a -> Int      -> IO a
  61    pokeElemOff :: Ptr a -> Int -> a -> IO ()
  62
  63    -- the same with *byte* offsets
  64    peekByteOff :: Ptr b -> Int      -> IO a
  65    pokeByteOff :: Ptr b -> Int -> a -> IO ()
  66
  67    -- ... and with no offsets at all
  68    peek        :: Ptr a      -> IO a
  69    poke        :: Ptr a -> a -> IO ()
  70
  71    -- free memory associated with the object
  72    -- (except the object pointer itself)
  73    destruct    :: Ptr a -> IO ()
  74
  75    -- circular default instances
  76    peekElemOff = peekElemOff_ undefined
  77       where peekElemOff_ :: a -> Ptr a -> Int -> IO a
  78             peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
  79    pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
  80
  81    peekByteOff ptr off = peek (ptr `plusPtr` off)
  82    pokeByteOff ptr off = poke (ptr `plusPtr` off)
  83
  84    peek ptr = peekElemOff ptr 0
  85    poke ptr = pokeElemOff ptr 0
  86
  87    destruct _ = return ()
  88 \end{code}
  89
  90 System-dependent, but rather obvious instances
  91
  92 \begin{code}
  93 instance Storable Bool where
  94    sizeOf _          = sizeOf (undefined::CInt)
  95    alignment _       = alignment (undefined::CInt)
  96    peekElemOff p i   = liftM (/= (0::CInt)) $ peekElemOff (castPtr p) i
  97    pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::CInt)
  98
  99 #define STORABLE(T,size,align,read,write)       \
 100 instance Storable (T) where {                   \
 101     sizeOf    _ = size;                         \
 102     alignment _ = align;                        \
 103     peekElemOff = read;                         \
 104     pokeElemOff = write }
 105
 106 STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
 107          readWideCharOffPtr,writeWideCharOffPtr)
 108
 109 STORABLE(Int,SIZEOF_LONG,ALIGNMENT_LONG,
 110          readIntOffPtr,writeIntOffPtr)
 111
 112 STORABLE(Word,SIZEOF_LONG,ALIGNMENT_LONG,
 113          readWordOffPtr,writeWordOffPtr)
 114
 115 STORABLE((Ptr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
 116          readPtrOffPtr,writePtrOffPtr)
 117
 118 STORABLE((FunPtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
 119          readFunPtrOffPtr,writeFunPtrOffPtr)
 120
 121 STORABLE((StablePtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
 122          readStablePtrOffPtr,writeStablePtrOffPtr)
 123
 124 STORABLE(Float,SIZEOF_FLOAT,ALIGNMENT_FLOAT,
 125          readFloatOffPtr,writeFloatOffPtr)
 126
 127 STORABLE(Double,SIZEOF_DOUBLE,ALIGNMENT_DOUBLE,
 128          readDoubleOffPtr,writeDoubleOffPtr)
 129
 130 STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
 131          readWord8OffPtr,writeWord8OffPtr)
 132
 133 STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
 134          readWord16OffPtr,writeWord16OffPtr)
 135
 136 STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
 137          readWord32OffPtr,writeWord32OffPtr)
 138
 139 STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
 140          readWord64OffPtr,writeWord64OffPtr)
 141
 142 STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
 143          readInt8OffPtr,writeInt8OffPtr)
 144
 145 STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
 146          readInt16OffPtr,writeInt16OffPtr)
 147
 148 STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
 149          readInt32OffPtr,writeInt32OffPtr)
 150
 151 STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
 152          readInt64OffPtr,writeInt64OffPtr)
 153
 154 #define NSTORABLE(T) \
 155 instance Storable T where { \
 156    sizeOf    (T x)       = sizeOf x ; \
 157    alignment (T x)       = alignment x ; \
 158    peekElemOff a i       = liftM T (peekElemOff (castPtr a) i) ; \
 159    pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x }
 160
 161 NSTORABLE(CChar)
 162 NSTORABLE(CSChar)
 163 NSTORABLE(CUChar)
 164 NSTORABLE(CShort)
 165 NSTORABLE(CUShort)
 166 NSTORABLE(CInt)
 167 NSTORABLE(CUInt)
 168 NSTORABLE(CLong)
 169 NSTORABLE(CULong)
 170 NSTORABLE(CLLong)
 171 NSTORABLE(CULLong)
 172 NSTORABLE(CFloat)
 173 NSTORABLE(CDouble)
 174 NSTORABLE(CLDouble)
 175 NSTORABLE(CPtrdiff)
 176 NSTORABLE(CSize)
 177 NSTORABLE(CWchar)
 178 NSTORABLE(CSigAtomic)
 179 NSTORABLE(CClock)
 180 NSTORABLE(CTime)
 181 \end{code}
 182
 183 Helper functions
 184
 185 \begin{code}
 186 #ifdef __GLASGOW_HASKELL__
 187
 188 readWideCharOffPtr  :: Ptr Char          -> Int -> IO Char
 189 readIntOffPtr       :: Ptr Int           -> Int -> IO Int
 190 readWordOffPtr      :: Ptr Word          -> Int -> IO Word
 191 readPtrOffPtr       :: Ptr (Ptr a)       -> Int -> IO (Ptr a)
 192 readFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> IO (FunPtr a)
 193 readFloatOffPtr     :: Ptr Float         -> Int -> IO Float
 194 readDoubleOffPtr    :: Ptr Double        -> Int -> IO Double
 195 readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a)
 196 readInt8OffPtr      :: Ptr Int8          -> Int -> IO Int8
 197 readInt16OffPtr     :: Ptr Int16         -> Int -> IO Int16
 198 readInt32OffPtr     :: Ptr Int32         -> Int -> IO Int32
 199 readInt64OffPtr     :: Ptr Int64         -> Int -> IO Int64
 200 readWord8OffPtr     :: Ptr Word8         -> Int -> IO Word8
 201 readWord16OffPtr    :: Ptr Word16        -> Int -> IO Word16
 202 readWord32OffPtr    :: Ptr Word32        -> Int -> IO Word32
 203 readWord64OffPtr    :: Ptr Word64        -> Int -> IO Word64
 204
 205 readWideCharOffPtr (Ptr a) (I# i)
 206   = IO $ \s -> case readWideCharOffAddr# a i s  of (# s2, x #) -> (# s2, C# x #)
 207 readIntOffPtr (Ptr a) (I# i)
 208   = IO $ \s -> case readIntOffAddr# a i s       of (# s2, x #) -> (# s2, I# x #)
 209 readWordOffPtr (Ptr a) (I# i)
 210   = IO $ \s -> case readWordOffAddr# a i s      of (# s2, x #) -> (# s2, W# x #)
 211 readPtrOffPtr (Ptr a) (I# i)
 212   = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, Ptr x #)
 213 readFunPtrOffPtr (Ptr a) (I# i)
 214   = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, FunPtr x #)
 215 readFloatOffPtr (Ptr a) (I# i)
 216   = IO $ \s -> case readFloatOffAddr# a i s     of (# s2, x #) -> (# s2, F# x #)
 217 readDoubleOffPtr (Ptr a) (I# i)
 218   = IO $ \s -> case readDoubleOffAddr# a i s    of (# s2, x #) -> (# s2, D# x #)
 219 readStablePtrOffPtr (Ptr a) (I# i)
 220   = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)
 221 readInt8OffPtr (Ptr a) (I# i)
 222   = IO $ \s -> case readInt8OffAddr# a i s      of (# s2, x #) -> (# s2, I8# x #)
 223 readInt16OffPtr (Ptr a) (I# i)
 224   = IO $ \s -> case readInt16OffAddr# a i s     of (# s2, x #) -> (# s2, I16# x #)
 225 readInt32OffPtr (Ptr a) (I# i)
 226   = IO $ \s -> case readInt32OffAddr# a i s     of (# s2, x #) -> (# s2, I32# x #)
 227 #if WORD_SIZE_IN_BYTES == 4
 228 readInt64OffPtr (Ptr a) (I# i)
 229   = IO $ \s -> case readInt64OffAddr# a i s     of (# s2, x #) -> (# s2, I64# x #)
 230 #else
 231 readInt64OffPtr (Ptr a) (I# i)
 232   = IO $ \s -> case readIntOffAddr# a i s       of (# s2, x #) -> (# s2, I64# x #)
 233 #endif
 234 readWord8OffPtr (Ptr a) (I# i)
 235   = IO $ \s -> case readWord8OffAddr# a i s     of (# s2, x #) -> (# s2, W8# x #)
 236 readWord16OffPtr (Ptr a) (I# i)
 237   = IO $ \s -> case readWord16OffAddr# a i s    of (# s2, x #) -> (# s2, W16# x #)
 238 readWord32OffPtr (Ptr a) (I# i)
 239   = IO $ \s -> case readWord32OffAddr# a i s    of (# s2, x #) -> (# s2, W32# x #)
 240 #if WORD_SIZE_IN_BYTES == 4
 241 readWord64OffPtr (Ptr a) (I# i)
 242   = IO $ \s -> case readWord64OffAddr# a i s    of (# s2, x #) -> (# s2, W64# x #)
 243 #else
 244 readWord64OffPtr (Ptr a) (I# i)
 245   = IO $ \s -> case readWordOffAddr# a i s      of (# s2, x #) -> (# s2, W64# x #)
 246 #endif
 247
 248 writeWideCharOffPtr  :: Ptr Char          -> Int -> Char        -> IO ()
 249 writeIntOffPtr       :: Ptr Int           -> Int -> Int         -> IO ()
 250 writeWordOffPtr      :: Ptr Word          -> Int -> Word        -> IO ()
 251 writePtrOffPtr       :: Ptr (Ptr a)       -> Int -> Ptr a       -> IO ()
 252 writeFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> FunPtr a    -> IO ()
 253 writeFloatOffPtr     :: Ptr Float         -> Int -> Float       -> IO ()
 254 writeDoubleOffPtr    :: Ptr Double        -> Int -> Double      -> IO ()
 255 writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO ()
 256 writeInt8OffPtr      :: Ptr Int8          -> Int -> Int8        -> IO ()
 257 writeInt16OffPtr     :: Ptr Int16         -> Int -> Int16       -> IO ()
 258 writeInt32OffPtr     :: Ptr Int32         -> Int -> Int32       -> IO ()
 259 writeInt64OffPtr     :: Ptr Int64         -> Int -> Int64       -> IO ()
 260 writeWord8OffPtr     :: Ptr Word8         -> Int -> Word8       -> IO ()
 261 writeWord16OffPtr    :: Ptr Word16        -> Int -> Word16      -> IO ()
 262 writeWord32OffPtr    :: Ptr Word32        -> Int -> Word32      -> IO ()
 263 writeWord64OffPtr    :: Ptr Word64        -> Int -> Word64      -> IO ()
 264
 265 writeWideCharOffPtr (Ptr a) (I# i) (C# x)
 266   = IO $ \s -> case writeWideCharOffAddr# a i x s  of s2 -> (# s2, () #)
 267 writeIntOffPtr (Ptr a) (I# i) (I# x)
 268   = IO $ \s -> case writeIntOffAddr# a i x s       of s2 -> (# s2, () #)
 269 writeWordOffPtr (Ptr a) (I# i) (W# x)
 270   = IO $ \s -> case writeWordOffAddr# a i x s      of s2 -> (# s2, () #)
 271 writePtrOffPtr (Ptr a) (I# i) (Ptr x)
 272   = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
 273 writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x)
 274   = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
 275 writeFloatOffPtr (Ptr a) (I# i) (F# x)
 276   = IO $ \s -> case writeFloatOffAddr# a i x s     of s2 -> (# s2, () #)
 277 writeDoubleOffPtr (Ptr a) (I# i) (D# x)
 278   = IO $ \s -> case writeDoubleOffAddr# a i x s    of s2 -> (# s2, () #)
 279 writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)
 280   = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)
 281 writeInt8OffPtr (Ptr a) (I# i) (I8# x)
 282   = IO $ \s -> case writeInt8OffAddr# a i x s      of s2 -> (# s2, () #)
 283 writeInt16OffPtr (Ptr a) (I# i) (I16# x)
 284   = IO $ \s -> case writeInt16OffAddr# a i x s     of s2 -> (# s2, () #)
 285 writeInt32OffPtr (Ptr a) (I# i) (I32# x)
 286   = IO $ \s -> case writeInt32OffAddr# a i x s     of s2 -> (# s2, () #)
 287 #if WORD_SIZE_IN_BYTES == 4
 288 writeInt64OffPtr (Ptr a) (I# i) (I64# x)
 289   = IO $ \s -> case writeInt64OffAddr# a i x s     of s2 -> (# s2, () #)
 290 #else
 291 writeInt64OffPtr (Ptr a) (I# i) (I64# x)
 292   = IO $ \s -> case writeIntOffAddr# a i x s       of s2 -> (# s2, () #)
 293 #endif
 294 writeWord8OffPtr (Ptr a) (I# i) (W8# x)
 295   = IO $ \s -> case writeWord8OffAddr# a i x s     of s2 -> (# s2, () #)
 296 writeWord16OffPtr (Ptr a) (I# i) (W16# x)
 297   = IO $ \s -> case writeWord16OffAddr# a i x s    of s2 -> (# s2, () #)
 298 writeWord32OffPtr (Ptr a) (I# i) (W32# x)
 299   = IO $ \s -> case writeWord32OffAddr# a i x s    of s2 -> (# s2, () #)
 300 #if WORD_SIZE_IN_BYTES == 4
 301 writeWord64OffPtr (Ptr a) (I# i) (W64# x)
 302   = IO $ \s -> case writeWord64OffAddr# a i x s    of s2 -> (# s2, () #)
 303 #else
 304 writeWord64OffPtr (Ptr a) (I# i) (W64# x)
 305   = IO $ \s -> case writeWordOffAddr# a i x s      of s2 -> (# s2, () #)
 306 #endif
 307
 308 #endif /* __GLASGOW_HASKELL__ */
 309 \end{code}