1{-# LANGUAGE Trustworthy #-}
2{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, BangPatterns #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  Foreign.Storable
7-- Copyright   :  (c) The FFI task force 2001
8-- License     :  see libraries/base/LICENSE
9--
10-- Maintainer  :  ffi@haskell.org
11-- Stability   :  provisional
12-- Portability :  portable
13--
14-- The module "Foreign.Storable" provides most elementary support for
15-- marshalling and is part of the language-independent portion of the
16-- Foreign Function Interface (FFI), and will normally be imported via
17-- the "Foreign" module.
18--
19-----------------------------------------------------------------------------
20
21module Foreign.Storable
22        ( Storable(
23             sizeOf,
24             alignment,
25             peekElemOff,
26             pokeElemOff,
27             peekByteOff,
28             pokeByteOff,
29             peek,
30             poke)
31        ) where
32
33
34#include "MachDeps.h"
35#include "HsBaseConfig.h"
36
37import GHC.Storable
38import GHC.Stable       ( StablePtr )
39import GHC.Num
40import GHC.Int
41import GHC.Word
42import GHC.Ptr
43import GHC.Base
44import GHC.Fingerprint.Type
45import Data.Bits
46import GHC.Real
47
48{- |
49The member functions of this class facilitate writing values of
50primitive types to raw memory (which may have been allocated with the
51above mentioned routines) and reading values from blocks of raw
52memory.  The class, furthermore, includes support for computing the
53storage requirements and alignment restrictions of storable types.
54
55Memory addresses are represented as values of type @'Ptr' a@, for some
56@a@ which is an instance of class 'Storable'.  The type argument to
57'Ptr' helps provide some valuable type safety in FFI code (you can\'t
58mix pointers of different types without an explicit cast), while
59helping the Haskell type system figure out which marshalling method is
60needed for a given pointer.
61
62All marshalling between Haskell and a foreign language ultimately
63boils down to translating Haskell data structures into the binary
64representation of a corresponding data structure of the foreign
65language and vice versa.  To code this marshalling in Haskell, it is
66necessary to manipulate primitive data types stored in unstructured
67memory blocks.  The class 'Storable' facilitates this manipulation on
68all types for which it is instantiated, which are the standard basic
69types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
70'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
71'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",
72as well as 'Ptr'.
73-}
74
75class Storable a where
76   {-# MINIMAL sizeOf, alignment,
77               (peek | peekElemOff | peekByteOff),
78               (poke | pokeElemOff | pokeByteOff) #-}
79
80   sizeOf      :: a -> Int
81   -- ^ Computes the storage requirements (in bytes) of the argument.
82   -- The value of the argument is not used.
83
84   alignment   :: a -> Int
85   -- ^ Computes the alignment constraint of the argument.  An
86   -- alignment constraint @x@ is fulfilled by any address divisible
87   -- by @x@.  The value of the argument is not used.
88
89   peekElemOff :: Ptr a -> Int      -> IO a
90   -- ^       Read a value from a memory area regarded as an array
91   --         of values of the same kind.  The first argument specifies
92   --         the start address of the array and the second the index into
93   --         the array (the first element of the array has index
94   --         @0@).  The following equality holds,
95   --
96   -- > peekElemOff addr idx = IOExts.fixIO $ \result ->
97   -- >   peek (addr `plusPtr` (idx * sizeOf result))
98   --
99   --         Note that this is only a specification, not
100   --         necessarily the concrete implementation of the
101   --         function.
102
103   pokeElemOff :: Ptr a -> Int -> a -> IO ()
104   -- ^       Write a value to a memory area regarded as an array of
105   --         values of the same kind.  The following equality holds:
106   --
107   -- > pokeElemOff addr idx x =
108   -- >   poke (addr `plusPtr` (idx * sizeOf x)) x
109
110   peekByteOff :: Ptr b -> Int      -> IO a
111   -- ^       Read a value from a memory location given by a base
112   --         address and offset.  The following equality holds:
113   --
114   -- > peekByteOff addr off = peek (addr `plusPtr` off)
115
116   pokeByteOff :: Ptr b -> Int -> a -> IO ()
117   -- ^       Write a value to a memory location given by a base
118   --         address and offset.  The following equality holds:
119   --
120   -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x
121
122   peek        :: Ptr a      -> IO a
123   -- ^ Read a value from the given memory location.
124   --
125   --  Note that the peek and poke functions might require properly
126   --  aligned addresses to function correctly.  This is architecture
127   --  dependent; thus, portable code should ensure that when peeking or
128   --  poking values of some type @a@, the alignment
129   --  constraint for @a@, as given by the function
130   --  'alignment' is fulfilled.
131
132   poke        :: Ptr a -> a -> IO ()
133   -- ^ Write the given value to the given memory location.  Alignment
134   -- restrictions might apply; see 'peek'.
135
136   -- circular default instances
137   peekElemOff = peekElemOff_ undefined
138      where peekElemOff_ :: a -> Ptr a -> Int -> IO a
139            peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
140   pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
141
142   peekByteOff ptr off = peek (ptr `plusPtr` off)
143   pokeByteOff ptr off = poke (ptr `plusPtr` off)
144
145   peek ptr = peekElemOff ptr 0
146   poke ptr = pokeElemOff ptr 0
147
148-- | @since 4.9.0.0
149instance Storable () where
150  sizeOf _ = 0
151  alignment _ = 1
152  peek _ = return ()
153  poke _ _ = return ()
154
155-- System-dependent, but rather obvious instances
156
157-- | @since 2.01
158instance Storable Bool where
159   sizeOf _          = sizeOf (undefined::HTYPE_INT)
160   alignment _       = alignment (undefined::HTYPE_INT)
161   peekElemOff p i   = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i
162   pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)
163
164#define STORABLE(T,size,align,read,write)       \
165instance Storable (T) where {                   \
166    sizeOf    _ = size;                         \
167    alignment _ = align;                        \
168    peekElemOff = read;                         \
169    pokeElemOff = write }
170
171-- | @since 2.01
172STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
173         readWideCharOffPtr,writeWideCharOffPtr)
174
175-- | @since 2.01
176STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
177         readIntOffPtr,writeIntOffPtr)
178
179-- | @since 2.01
180STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
181         readWordOffPtr,writeWordOffPtr)
182
183-- | @since 2.01
184STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
185         readPtrOffPtr,writePtrOffPtr)
186
187-- | @since 2.01
188STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
189         readFunPtrOffPtr,writeFunPtrOffPtr)
190
191-- | @since 2.01
192STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
193         readStablePtrOffPtr,writeStablePtrOffPtr)
194
195-- | @since 2.01
196STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
197         readFloatOffPtr,writeFloatOffPtr)
198
199-- | @since 2.01
200STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
201         readDoubleOffPtr,writeDoubleOffPtr)
202
203-- | @since 2.01
204STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
205         readWord8OffPtr,writeWord8OffPtr)
206
207-- | @since 2.01
208STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
209         readWord16OffPtr,writeWord16OffPtr)
210
211-- | @since 2.01
212STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
213         readWord32OffPtr,writeWord32OffPtr)
214
215-- | @since 2.01
216STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
217         readWord64OffPtr,writeWord64OffPtr)
218
219-- | @since 2.01
220STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
221         readInt8OffPtr,writeInt8OffPtr)
222
223-- | @since 2.01
224STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
225         readInt16OffPtr,writeInt16OffPtr)
226
227-- | @since 2.01
228STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
229         readInt32OffPtr,writeInt32OffPtr)
230
231-- | @since 2.01
232STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
233         readInt64OffPtr,writeInt64OffPtr)
234
235-- | @since 4.8.0.0
236instance (Storable a, Integral a) => Storable (Ratio a) where
237    sizeOf _    = 2 * sizeOf (undefined :: a)
238    alignment _ = alignment (undefined :: a )
239    peek p           = do
240                        q <- return $ castPtr p
241                        r <- peek q
242                        i <- peekElemOff q 1
243                        return (r % i)
244    poke p (r :% i)  = do
245                        q <-return $  (castPtr p)
246                        poke q r
247                        pokeElemOff q 1 i
248
249-- XXX: here to avoid orphan instance in GHC.Fingerprint
250-- | @since 4.4.0.0
251instance Storable Fingerprint where
252  sizeOf _ = 16
253  alignment _ = 8
254  peek = peekFingerprint
255  poke = pokeFingerprint
256
257-- peek/poke in fixed BIG-endian 128-bit format
258peekFingerprint :: Ptr Fingerprint -> IO Fingerprint
259peekFingerprint p0 = do
260      let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
261          peekW64 _  0  !i = return i
262          peekW64 !p !n !i = do
263                w8 <- peek p
264                peekW64 (p `plusPtr` 1) (n-1)
265                    ((i `shiftL` 8) .|. fromIntegral w8)
266
267      high <- peekW64 (castPtr p0) 8 0
268      low  <- peekW64 (castPtr p0 `plusPtr` 8) 8 0
269      return (Fingerprint high low)
270
271pokeFingerprint :: Ptr Fingerprint -> Fingerprint -> IO ()
272pokeFingerprint p0 (Fingerprint high low) = do
273      let pokeW64 :: Ptr Word8 -> Int -> Word64 -> IO ()
274          pokeW64 _ 0  _  = return ()
275          pokeW64 p !n !i = do
276                pokeElemOff p (n-1) (fromIntegral i)
277                pokeW64 p (n-1) (i `shiftR` 8)
278
279      pokeW64 (castPtr p0) 8 high
280      pokeW64 (castPtr p0 `plusPtr` 8) 8 low
281