Foreign C with pointers

John Vogel jpvogel1 at gmail.com
Tue Dec 18 19:06:14 EST 2007


You do realize that the example you gave is just as general as all the
tutorials.

Here is an example I was working, but it gives a *segmentation fault* for
some reason:

example.h

typedef struct
{
unsigned char a;
unsigned char b;
unsigned char c;
unsigned char d;
} IP;

IP* shiftIP(IP* addr);


example.c

#include "example.h"

IP* shiftIP(IP* addr){
unsigned char t;
t = addr->a;
addr->a = addr->b;
addr->b = addr->c;
addr->c = addr->d;
addr->d = t;
}

Example.hsc

{-# OPTIONS -ffi -fglasgow-exts #-}
module Example where

import Foreign
import Foreign.C.Types
import Control.Monad

#include "buzz.h"

data MyIP = MyIP
{ a :: CUChar
, b :: CUChar
, c :: CUChar
, d :: CUChar
} deriving (Show)

instance Storable MyIP where
sizeOf _ = #{size IP} -- 4
alignment _ = alignment (undefined :: CUChar) -- 1
peek p = return MyIP
  `ap` (#{peek IP, a} p)
  `ap` (#{peek IP, b} p)
  `ap` (#{peek IP, c} p)
  `ap` (#{peek IP, d} p)
poke p ip = do
  #{poke IP, a} p $ a ip
  #{poke IP, b} p $ b ip
  #{poke IP, c} p $ c ip
  #{poke IP, d} p $ d ip

foreign import ccall safe "static buzzlib.h shiftIP"
shiftIP :: Ptr MyIP -> Ptr MyIP

shiftMyIP :: MyIP -> MyIP
shiftMyIP ip = unsafePerformIO . alloca $ \ptr -> poke ptr ip >> peek
(shiftIP ptr)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/glasgow-haskell-users/attachments/20071218/744597a8/attachment-0001.htm


More information about the Glasgow-haskell-users mailing list