- Cvs-hugs - Haskell.org

cvs commit: hugs98/src HsFFI.h builtin.c connect.h ffi.c static.c
by Alastair Reid 17 Jun '02

17 Jun '02

reid 2002/06/17 14:46:48 PDT Modified files: src HsFFI.h builtin.c connect.h ffi.c static.c Log: Made dynamic and wrapper forms work. This is my current test program: import Foreign import Exception import Prelude hiding (read) tests = do putStrLn "\nTesting sin==mysin (should return lots of Trues)" print (testSin sin mysin) putStrLn "\nTesting errno" err <- peek errno putStrLn $ "errno == " ++ show err putStrLn "\nTesting puts (and withString)" withString0 "Test successful" puts putStrLn "\nTesting peekArray0" s <- withString0 "Test successful" (peekArray0 '\0') putStr s putStrLn "\nTesting open, read and close" s <- testRead "test.hs" 200 putStrLn s putStrLn "\nTesting open, write and close" testWrite "/tmp/test_write" "Test successful" putStrLn "\nTesting sin==dynamic_sin (should return lots of Trues)" print (testSin sin (dyn_sin sin_addr)) putStrLn "\nTesting sin==IO wrapped_sin (should return lots of Trues)" sin_addr2 <- wrapIO (return . sin) print (testSin sin (unsafePerformIO . (dyn_sinIO sin_addr2))) freeHaskellFunPtr sin_addr2 putStrLn "\nTesting sin==Id wrapped_sin (should return lots of Trues)" sin_addr3 <- wrapId sin print (testSin sin (dyn_sin sin_addr3)) freeHaskellFunPtr sin_addr3 putStrLn "\nTesting exit" exit 3 testSin f g = [ (f x == g x) | x <- [0,0.01 .. 1] ] foreign import ccall "sin" mysin :: Double -> Double foreign import ccall "dynamic" dyn_sin :: FunPtr (Double -> Double) -> (Double -> Double) foreign import ccall "dynamic" dyn_sinIO :: FunPtr (Double -> IO Double) -> (Double -> IO Double) foreign import ccall "&sin" sin_addr :: FunPtr (Double -> Double) foreign import ccall "wrapper" wrapId :: (Double -> Double) -> IO (FunPtr (Double -> Double)) foreign import ccall "wrapper" wrapIO :: (Double -> IO Double) -> IO (FunPtr (Double -> IO Double)) foreign import ccall safe "static stdlib.h &errno" errno :: Ptr Int withString s = bracket (newArray s) free withString0 s = bracket (newArray0 '\0' s) free withBuffer sz m = do b <- mallocArray sz sz' <- m b s <- peekArray sz' b free b return s foreign import ccall puts :: Ptr Char -> IO Int foreign import ccall "open" open' :: Ptr Char -> Int -> IO Int foreign import ccall "open" open2' :: Ptr Char -> Int -> Int -> IO Int foreign import ccall "creat" creat' :: Ptr Char -> Int -> IO Int foreign import ccall close :: Int -> IO Int foreign import ccall "read" read' :: Int -> Ptr Char -> Int -> IO Int foreign import ccall "write" write' :: Int -> Ptr Char -> Int -> IO Int creat s m = withString0 s $ \s' -> unix "creat" $ creat' s' m open s m = withString0 s $ \s' -> unix "open" $ open' s' m open2 s m n = withString0 s $ \s' -> unix "open2" $ open2' s' m n write fd s = withString0 s $ \s' -> unix "write" $ write' fd s' (length s) read fd sz = withBuffer sz $ \s' -> unix "read" $ read' fd s' sz unix s m = do x <- m if x < 0 then do err <- peek errno ioError $ userError $ s ++ ": " ++ show (x,err) else return x testRead fn sz = bracket (open fn 0) close (flip read sz) testWrite fn s = bracket (open2 fn (512+64+1) 511) close (flip write s) foreign import ccall exit :: Int -> IO () -- Various bits of rubbish. -- foreign import ccall "static stdlib.h exit" (***) :: Ptr Char -> Ptr Char -> IO Int -- -- foreign import ccall safe "static stdlib.h printf" (+++) :: Ptr Char -> Ptr Char -> IO Int -- foreign import ccall safe "static stdlib.h &errno" illegal_foo :: Ptr Int -- -- foreign import ccall safe "wrapper" illegal_bar :: Char -> IO (FunPtr Char) -- foreign import ccall safe "dynamic" illegal_baz :: FunPtr Char -> Char -- foreign export ccall "id_charstar" id :: Ptr Char -> Ptr Char Revision Changes Path 1.4 +8 -3 hugs98/src/HsFFI.h 1.26 +30 -5 hugs98/src/builtin.c 1.38 +3 -3 hugs98/src/connect.h 1.10 +36 -11 hugs98/src/ffi.c 1.72 +20 -4 hugs98/src/static.c

1 0

cvs commit: hugs98/lib/exts Foreign.hs Ptr.hs FunPtr.hs
by Alastair Reid 17 Jun '02

17 Jun '02

reid 2002/06/17 14:44:52 PDT Modified files: lib/exts Foreign.hs Ptr.hs Removed files: lib/exts FunPtr.hs Log: Killed FunPtr - I'd misread the ffi spec when I added it. Brought FunPtr impln closer to ffi spec. Added unsafePerformIO to Foreign Revision Changes Path 1.5 +2 -0 hugs98/lib/exts/Foreign.hs 1.2 +19 -3 hugs98/lib/exts/Ptr.hs

1 0

cvs commit: hugs98/src storage.c
by Alastair Reid 17 Jun '02

17 Jun '02

reid 2002/06/17 14:43:11 PDT Modified files: src storage.c Log: Added FLOATCELL support to debug printer Revision Changes Path 1.43 +5 -2 hugs98/src/storage.c

1 0

cvs commit: hugs98/lib Prelude.hs
by Alastair Reid 17 Jun '02

17 Jun '02

reid 2002/06/17 14:42:37 PDT Modified files: lib Prelude.hs Log: Added a decent error message when the IO scheduler loop hits an unrecognised thunk. The previous error message of 'undefined' didn't really do it for me. Revision Changes Path 1.27 +1 -1 hugs98/lib/Prelude.hs

1 0

cvs commit: hugs98/src ffi.c
by Sigbjorn Finne 17 Jun '02

17 Jun '02

sof 2002/06/17 09:29:15 PDT Modified files: src ffi.c Log: Simple-minded additions for compiling via MSVC Revision Changes Path 1.9 +20 -4 hugs98/src/ffi.c

2 2

cvs commit: hugs98/src builtin.c
by Sigbjorn Finne 17 Jun '02

17 Jun '02

sof 2002/06/17 09:27:46 PDT Modified files: src builtin.c Log: proto wibble Revision Changes Path 1.25 +13 -6 hugs98/src/builtin.c

1 0

cvs commit: hugs98/src HsFFI.h
by Sigbjorn Finne 17 Jun '02

17 Jun '02

sof 2002/06/17 09:26:25 PDT Modified files: src HsFFI.h Log: Tweaks to support MSVC's 64-bit types Revision Changes Path 1.3 +18 -8 hugs98/src/HsFFI.h

1 0

cvs commit: hugs98/lib/exts Storable.hs Storable_aux.c hugs98/src ffi.c
by Alastair Reid 15 Jun '02

15 Jun '02

reid 2002/06/14 18:12:33 PDT Modified files: lib/exts Storable.hs Storable_aux.c src ffi.c Log: ffi.c: Generates correct code for CAFs Storable: Contains instances for all types. (The alignment field is 1 for all entries. This is because I can't think of an appropriate piece of code to determine the correct alignment at runtime. Would sizeof be a conservative guess?) Revision Changes Path 1.3 +68 -47 hugs98/lib/exts/Storable.hs 1.2 +22 -16 hugs98/lib/exts/Storable_aux.c 1.8 +10 -12 hugs98/src/ffi.c

1 0

cvs commit: hugs98/lib/exts Storable.hs hugs98/src MkInstal.in connect.h ffi.c machdep.c static.c storage.c storage.h
by Alastair Reid 15 Jun '02

15 Jun '02

reid 2002/06/14 17:29:10 PDT Modified files: lib/exts Storable.hs src MkInstal.in connect.h ffi.c machdep.c static.c storage.c storage.h Log: Tweaked install to install HsFFI.h in $prefix/share/hugs/include As a result you have to 'make install' before testing the code. Note: Use of the install directory $prefix/share/hugs isn't really appropriate since HsFFI.h is machine dependent and any libraries containing ffi code will be machine dependent too. Tweaked ffi code to compile the code it generates. (As before, the code needs autoconfed. It currently uses cc -shared and it assumes directory separators of "/".) Note: There's now an awful lot of code scattered around Hugs for manipulating strings: parsing them, finding substrings (notable equivalents of gnumake's basename, notdir, dir, etc.). A very worthwhile task would be to create a proper library of string manipulation code (taking care of all the overflow issues properly, etc.) and clean up all the cruft that has accumulated. A suitable test sequence for the ffi looks like this: cd unix ./configure --prefix=$HOME/tmp make install cc -I. ../lib/exts/Storable_aux.c -c -o ../lib/exts/Storable_aux.o $HOME/tmp/bin/hugs +G test.hs < /dev/null $HOME/tmp/bin/hugs test.hs stty sane ToDo: Add some file modification time code to build the .{c,so} files only if needed. Hmmm, but how do we define 'needed'? The right thing to do is a dependency analysis from this module. Revision Changes Path 1.2 +2 -2 hugs98/lib/exts/Storable.hs 1.7 +1 -0 hugs98/src/MkInstal.in 1.37 +7 -4 hugs98/src/connect.h 1.7 +93 -8 hugs98/src/ffi.c 1.52 +21 -7 hugs98/src/machdep.c 1.71 +19 -10 hugs98/src/static.c 1.42 +3 -2 hugs98/src/storage.c 1.38 +3 -2 hugs98/src/storage.h

1 0

cvs commit: hugs98/lib/exts ForeignObj.hs
by Alastair Reid 14 Jun '02

14 Jun '02

reid 2002/06/14 08:02:39 PDT Added files: lib/exts ForeignObj.hs Log: Missing Commit. Note that Hugs does not implement the ForeignPtr type. I'm leaving that pending some agreement about changing the API so that it can be implemented without adding preemptive concurrency to your Haskell implementation.

1 0