Assuming the following files:
test2.h:
typedef int (*signature) ();
extern const signature lol2;
test2.c:
#include "test2.h"
int lol() {
return 42;
}
const signature lol2 = lol;
Test2.hs:
module Main where
import Foreign.C
import Foreign.Ptr
type Fun =
IO CInt
foreign import ccall
"test2.h lol2"
fun_ptr
:: FunPtr Fun
foreign import ccall "dynamic" mkFun :: FunPtr Fun -> Fun
lol = mkFun fun_ptr
main = do
fortytwo <- lol
putStrLn $ show $ fortytwo
With the following compilation:
gcc -shared test2.c -Wall -Wextra -o libtest2.so -g3 -ggdb3
ghc -o test2 Test2.hs -ltest2 -optl-Wl,-rpath,. -L. -g
(GHC emits a warning about a missing "&" before the lol2 declaration, but I think the warning is wrong, so I ignore it. Also, note that I am not using -dynamic. If I do, the results are the same)
But, I get a SIGSEGV while running:
(gdb) break scheduleWaitThread
Breakpoint 1 at 0x468150: file rts/Schedule.c, line 2509.
(gdb) r
Starting program: [...]/test2
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".
Breakpoint 1, scheduleWaitThread (tso=0x4200105388, ret=ret#entry=0x0, pcap=pcap#entry=0x7fffffffd7f8) at rts/Schedule.c:2509
2509 rts/Schedule.c: No such file or directory.
(gdb) bt
#0 scheduleWaitThread (tso=0x4200105388, ret=ret#entry=0x0, pcap=pcap#entry=0x7fffffffd7f8) at rts/Schedule.c:2509
#1 0x0000000000483864 in rts_evalLazyIO (cap=cap#entry=0x7fffffffd7f8, p=p#entry=0x4a5420, ret=ret#entry=0x0) at rts/RtsAPI.c:530
#2 0x00000000004707ae in hs_main (argc=1, argv=0x7fffffffd9e8, main_closure=0x4a5420, rts_config=...) at rts/RtsMain.c:72
#3 0x0000000000406b46 in main ()
(gdb) finish
Run till exit from #0 scheduleWaitThread (tso=0x4200105388, ret=ret#entry=0x0, pcap=pcap#entry=0x7fffffffd7f8) at rts/Schedule.c:2509
Program received signal SIGSEGV, Segmentation fault.
0x00000000004a4d90 in lol2 ()
(gdb)
After the crash the stack seems unusable:
(gdb) bt
#0 0x00000000004a4d90 in lol2 ()
#1 0x000000000040669d in r2ad_info ()
#2 0x0000000000000000 in ?? ()
What am I doing wrong? How can I debug this?
ccall can only import functions, but lol2 is no function. Use a capi import with a value qualification:
{-# LANGUAGE CApiFFI #-}
module Main where
-- ... etc ...
foreign import capi "test2.h value lol2" fun_ptr :: FunPtr Fun
-- ... etc ...
It's not immediately obvious, but the manual says to do this, and it works. The warning message you've seen still comes up; I think you may want to report that as a bug.
Related
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
I want to foreign import a function from some c header, but how to deal with the stderr of type FILE* which defined as:
extern FILE* __stderrp;
#define stderr __stderrp
Maybe not precisely. I use c2hs for my ffi work, and already have:
{#pointer *FILE as File foreign finalizer fclose newtype#}
but I can not import stderr like this:
foreign import ccall "stdio.h stderr" stderr :: File
My c function has the signature:
void func(FILE*);
I can import func with c2hs:
{#fun func as ^ {`File'} -> `()'#}
I need to use stderr to run func:
func(stderr);
I am noob with the foreign import mechanism. It seems I can not import stderr in this way.
ps. Maybe I would wrap my func in a new function
void func2(void){func(stderr);}
This is a workaround, but seems not clean.
It's not unusual to require some kind of "shim" when writing FFI code for Haskell, and I'd encourage you to just write a helper function:
FILE* get_stderr() { return stderr; }
and use that (see example at the bottom of this answer).
However, I was able to get the following minimal example to work by using the vanilla FFI's support for static pointers -- it doesn't import stderr directly, but imports a pointer to the stderr pointer. This kind of import is not directly supported by c2hs, so the interface code is ugly, and I don't think there's any way to avoid having to fetch the stderr pointer value in the IO monad, independent of whether or not you use c2hs.
// file.h
#include <stdio.h>
void func(FILE*);
// file.c
#include "file.h"
void func(FILE *f) {
fputs("Output to stderr!\n", f);
}
// File.chs
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
import Foreign
#include "file.h"
{#pointer *FILE as File newtype#}
{#fun func as ^ { `File' } -> `()'#}
foreign import ccall "&stderr" stderr_ptr :: Ptr (Ptr File)
main :: IO ()
main = do stderr <- File <$> peek stderr_ptr
func stderr
For comparison, this minimal example with the helper function looks much cleaner at the Haskell level:
// file.h
#include <stdio.h>
void func(FILE*);
FILE* get_stderr(void);
// file.c
#include "file.h"
void func(FILE *f) {
fputs("Output to stderr!\n", f);
}
FILE* get_stderr(void) {return stderr; }
// File.chs
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
#include "file.h"
{#pointer *FILE as File newtype#}
{#fun func as ^ { `File' } -> `()'#}
{#fun pure get_stderr as ^ {} -> `File'#}
main :: IO ()
main = func getStderr
Note that in both these examples, I removed your fclose finalizer. You probably don't want Haskell arbitrarily deciding it's a good time to close stderr on you.
With c2hs of version 0.28.2, the following code works:
-- lib.chs
{#pointer *FILE as File newtype#}
foreign import ccall "stdio.h &__stderrp" c_stderr :: Ptr (Ptr File) -- can not just use "stdio.h &stderr", this may cause a reference error
-- main.hs
stderr <- File <$> peek c_stderr
func stderr
I'd like to build the 32-bit DLL with 64-bit GHC. And here is the minimal example.
Test.hs
{-# LANGUAGE ForeignFunctionInterface #-}
module Test where
import Foreign.C.Types
foreign export ccall c_hello :: IO()
foreign export ccall boo :: CInt
c_hello :: IO()
c_hello = do
print "Hello!"
init_exit.cpp
#include "Test_stub.h"
#include <C:\Program Files\Haskell Platform\8.0.1\lib\include\Rts.h>
#define DLLExport extern "C" __declspec(dllexport)
DLLExport void hello()
{
c_hello();
}
DLLExport int HsStart()
{
int argc = 1;
char* argv[] = {"ghcDLL", NULL};
char** args = argv;
hs_init(&argc, &args);
printf("Haskell library has been initialized!\n");
return 0;
}
DLLExport int HsEnd()
{
hs_exit();
printf("Haskell library has been finalized!\n");
return 0;
}
And then I build the library, using the following commands:
ghc -c -O Test.hs
ghc -c init_exit.cpp
ghc -shared -o Test.dll Test.o init_exit.o
What flags should I pass to ghc or maybe to gcc to build the 32-bit DLL instead of 64-bit? Or maybe there is another way to do this.
A normal Windows 64-bit GHC build (such as the one you can download from the GHC website) is only capable of building 64-bit object files. For example, it doesn't include 32-bit versions of any of the libraries that come with GHC.
Your options are to build a Windows 64-bit to Windows 32-bit cross-compiler, or just run the normal Windows 32-bit build of GHC (probably much easier).
This is the standard Hello World CUDA file:
#include <stdio.h>
#include "hello.h"
const int N = 7;
const int blocksize = 7;
__global__ void hello_kernel(char *a, int *b) {
a[threadIdx.x] += b[threadIdx.x];
}
#define cudaCheckError() { \
cudaError_t e=cudaGetLastError(); \
if(e!=cudaSuccess) { \
printf("Cuda failure %s:%d: '%s'\n",__FILE__,__LINE__,cudaGetErrorString(e)); \
exit(0); \
} \
}
void hello() {
char a[N] = "Hello ";
int b[N] = {15, 10, 6, 0, -11, 1, 0};
char *ad;
int *bd;
const int csize = N*sizeof(char);
const int isize = N*sizeof(int);
printf("%s", a);
cudaMalloc( (void**)&ad, csize );
cudaMemcpy( ad, a, csize, cudaMemcpyHostToDevice );
cudaCheckError();
cudaMalloc( (void**)&bd, isize );
cudaMemcpy( bd, b, isize, cudaMemcpyHostToDevice );
cudaCheckError();
dim3 dimBlock( blocksize, 1 );
dim3 dimGrid( 1, 1 );
hello_kernel<<<dimGrid, dimBlock>>>(ad, bd);
cudaMemcpy( a, ad, csize, cudaMemcpyDeviceToHost );
cudaCheckError();
cudaFree( ad );
cudaCheckError();
printf("%s\n", a);
}
And its header:
-- hello.h
extern "C"
void hello();
That's a Haskell file that calls such function:
-- test.hs
{-# LANGUAGE ForeignFunctionInterface #-}
import Foreign.C
import Foreign.Ptr (Ptr,nullPtr)
foreign import ccall "hello" hello :: IO ()
main = hello
I'm compiling it with:
nvcc hello.c -c -o hello.o
ghc test.hs -o test hello.o -L/usr/local/cuda/lib -optl-lcudart
Running that program with ./test results in:
Hello Cuda failure hello.cu:32: 'no CUDA-capable device is detected'
Running the same program with a C main() that just calls hello produces Hello World, as expected.
How do I make Haskell detect the device correctly?
Maybe unrelated, but I was able to reproduce your error on a Mac with separate on-board and discrete graphics cards. When "Automatic graphics switching" is enabled in System Preferences (and no 3D graphics applications are running), I get the same "no CUDA-capable device is detected" error.
When I turn off automatic graphics switching, it forces the Mac to use the discrete graphics card, and then the program runs as expected.
The purely C/CUDA-based version of the code doesn't seem to be affected by this preference and always works whether automatic switching is enabled or not.
Using ghc 7.8.3 and nvcc V6.5.12, I found that your code works as expected. The only different thing that I did was name hello.c as hello.cu.
/:cuda_haskell> nvcc --version
nvcc: NVIDIA (R) Cuda compiler driver
Copyright (c) 2005-2014 NVIDIA Corporation
Built on Thu_Jul_17_19:13:24_CDT_2014
Cuda compilation tools, release 6.5, V6.5.12
/:cuda_haskell> nvcc -o hello.o -c hello.cu
/:cuda_haskell> ghc main.hs -o hello_hs hello.o -L/usr/local/cuda/lib -optl-lcudart
Linking hello_hs ...
/:cuda_haskell> ./hello_hs
Hello World!
/:cuda_haskell> cat main.hs
-- main.hs
{-# LANGUAGE ForeignFunctionInterface #-}
import Foreign.C
import Foreign.Ptr (Ptr,nullPtr)
foreign import ccall "hello" hello :: IO ()
main = hello
I'm working on a Haskell daemon that uses POSIX fork/exec together with file locking mechanism. My experiments show that file locks aren't inherited during executeFile with -threaded runtime (see also this thread), no matter if I use +RTS -N or not. So I'd like to add a check to be sure that the daemon ins't compiled with -threaded. Is there a portable way to detect it?
There is a value in Control.Concurrent for this, for example:
module Main (main) where
import Control.Concurrent
main :: IO ()
main = print rtsSupportsBoundThreads
And test:
$ ghc -fforce-recomp Test.hs; ./Test
[1 of 1] Compiling Main ( Test.hs, Test.o )
Linking Test ...
False
$ ghc -fforce-recomp -threaded Test.hs; ./Test
[1 of 1] Compiling Main ( Test.hs, Test.o )
Linking Test ...
True
And it's C-part source code:
HsBool
rtsSupportsBoundThreads(void)
{
#if defined(THREADED_RTS)
return HS_BOOL_TRUE;
#else
return HS_BOOL_FALSE;
#endif
}
This is a dirty hack and might be not portable but I can confirm it works for ghc-7.6.3 on linux:
isThreaded :: IO (Maybe Bool)
isThreaded = do
tid <- forkIO $ threadDelay 1000000
yield
stat <- threadStatus tid
killThread tid
case stat of
ThreadBlocked BlockedOnMVar -> return (Just True)
ThreadBlocked BlockedOnOther -> return (Just False)
_ -> return Nothing
See BlockedOnOther docstring for details.
There is a function in the wiringPi 'C' library called delay with type
void delay(unsigned int howLong);
This function delays execution of code for howLong milliseconds. I wrote the binding code in haskell to be able to call this function. The haskell code is as follows,
foreign import ccall "wiringPi.h delay" c_delay :: CUInt -> IO ()
hdelay :: Int -> IO ()
hdelay howlong = c_delay (fromIntegral howlong)
After this, I wrote a simple haskell program to call this function. The simply haskell code is as follows..
--After importing relavent libraries I did
main = wiringPiSetup
>> delay 5000
But the delay does not happen or rather the executable generated by the ghc compiler exits right away.
Could someone tell me what could possibly go wrong here? A small nudge in the right direction would help.
Cheers and Regards.
Please ignore the part in block quote, and see update below - I am preserving the original non-solution because of comments associated with it.
You should mark the import as unsafe since you want the main
thread to block while the function is executing (see comment below by
#carl). By default, import is safe, not unsafe. So, changing
the function signature to this should make the main thread block:
foreign import ccall unsafe "wiring.h delay" c_delay :: CUInt -> IO ()
Also, if you plan to write multi-threaded code, GHC docs for multi-threaded FFI is >very useful. This also seems a good starter.
Update
The behavior seems to be due to signal interrupt handling (if I recall correctly, this was added in GHC 7.4+ to fix some bugs). More details here:
http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Signals
Please note the comment on the above page: Signal handling differs between the threaded version of the runtime and the non-threaded version.
Approach 1 - Handle signal interrupt in FFI code:
A toy code is below which handles the interrupt in sleep. I tested it on Linux 2.6.18 with ghc 7.6.1.
C code:
/** ctest.c **/
#include <unistd.h>
#include <stdio.h>
#include <time.h>
unsigned delay(unsigned sec)
{
struct timespec req={0};
req.tv_sec = sec;
req.tv_nsec = 0;
while (nanosleep(&req, &req) == -1) {
printf("Got interrupt, continuing\n");
continue;
}
return 1;
}
Haskell code:
{-# LANGUAGE ForeignFunctionInterface #-}
-- Filename Test.hs
module Main (main) where
import Foreign.C.Types
foreign import ccall safe "delay" delay :: CUInt -> IO CUInt
main = do
putStrLn "Sleeping"
n <- delay 2000
putStrLn $ "Got return code from sleep: " ++ show n
Now, after compiling with ghc 7.6.1 (command: ghc Test.hs ctest.c), it waits until sleep finishes, and prints a message every time it gets an interrupt signal during sleep:
./Test
Sleeping
Got interrupt, continuing
Got interrupt, continuing
Got interrupt, continuing
Got interrupt, continuing
....
....
Got return code from sleep: 1
Approach 2 - Disable SIGVTALRM before calling FFI code, and re-enable:
I am not sure what the implications are for disabling SIGVTALRM. This is alternative approach which disables SIGVTALRM during FFI call, if you can't alter FFI code. So, FFI code is not interrupted during sleep (assuming it is SIGVTALRM that is causing the interrupt).
{-# LANGUAGE ForeignFunctionInterface #-}
-- Test.hs
module Main (main) where
import Foreign.C.Types
import System.Posix.Signals
foreign import ccall safe "delay" delay :: CUInt -> IO CUInt
main = do
putStrLn "Sleeping"
-- Block SIGVTALRM temporarily to avoid interrupts while sleeping
blockSignals $ addSignal sigVTALRM emptySignalSet
n <- delay 2
putStrLn $ "Got return code from sleep: " ++ show n
-- Unblock SIGVTALRM
unblockSignals $ addSignal sigVTALRM emptySignalSet
return ()