ed2c73b · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Fix handling of multiple value functions as C callbacks

commited2c73b644c6e019624ae7252b760985e8726750 authorNiklas Larsson <niklas@mm.st> dateSat 19 Mar 2016, 11:45 (11 years ago) parentec97cac

5 files changed+30−6

compare with master

unifiedsplit

src/IRTS/CodegenC.hs+14−6 test/ffi007/expected+1 test/ffi007/ffi007.c+4 test/ffi007/ffi007.h+2 test/ffi007/ffi007.idr+9

src/IRTS/CodegenC.hs+14−6

@@ -811,12 +811,7 @@ genWrapper (desc, tag) = ret ++ " " ++ wrapperName tag ++ "(" ++

811811 indent 1 ++ "RESERVE(" ++ show (len + 1) ++ ");\n" ++

812812 indent 1 ++ "allocCon(REG1, vm, " ++ show tag ++ ",0 , 0);\n" ++

813813 indent 1 ++ "TOP(0) = REG1;\n" ++

814−

815− push 1 argList ++

816− indent 1 ++ "STOREOLD;\n" ++

817− indent 1 ++ "BASETOP(0);\n" ++

818− indent 1 ++ "ADDTOP(" ++ show (len + 1) ++ ");\n" ++

819− indent 1 ++ "CALL(_idris__123_APPLY0_125_);\n" ++

814+ applyArgs argList ++

820815 if ret /= "void"

821816 then indent 1 ++ "ret = " ++ irts_c (toFType ft) "RVAL" ++ ";\n"

822817 ++ indent 1 ++ "return ret;\n}\n\n"

@@ -825,6 +820,19 @@ genWrapper (desc, tag) = ret ++ " " ++ wrapperName tag ++ "(" ++

825820 (ret, ft) = rty desc

826821 argList = zip (args desc) [0..]

827822 len = length argList

823+

824+ applyArgs (x:y:xs) = push 1 [x] ++

825+ indent 1 ++ "STOREOLD;\n" ++

826+ indent 1 ++ "BASETOP(0);\n" ++

827+ indent 1 ++ "ADDTOP(2);\n" ++

828+ indent 1 ++ "CALL(_idris__123_APPLY0_125_);\n" ++

829+ indent 1 ++ "TOP(0)=REG1;\n" ++

830+ applyArgs (y:xs)

831+ applyArgs x = push 1 x ++

832+ indent 1 ++ "STOREOLD;\n" ++

833+ indent 1 ++ "BASETOP(0);\n" ++

834+ indent 1 ++ "ADDTOP(" ++ show (length x + 1) ++ ");\n" ++

835+ indent 1 ++ "CALL(_idris__123_APPLY0_125_);\n"

828836 renderArgs [] = "void"

829837 renderArgs [((s, _), n)] = s ++ " a" ++ (show n)

830838 renderArgs (((s, _), n):xs) = s ++ " a" ++ (show n) ++ ", " ++

test/ffi007/expected+1

@@ -6,3 +6,4 @@ After calling callback

6600000377

77I'm dynamic 3

886

9+7

test/ffi007/ffi007.c+4

@@ -28,3 +28,7 @@ int dynamic_fn(int i) {

2828callback test_ffi6(void) {

2929 return &dynamic_fn;

3030}

31+

32+void test_mulpar(void (*fn)(int, int)) {

33+ fn(3,4);

34+}

test/ffi007/ffi007.h+2

@@ -9,3 +9,5 @@ void test_ffi2(int (*cb)(char*));

99void test_ffi3(void (*cb)(void));

1010

1111callback test_ffi6(void);

12+

13+void test_mulpar(void (*fn)(int, int));

test/ffi007/ffi007.idr+9

@@ -34,6 +34,14 @@ test6 = foreign FFI_C "test_ffi6" (IO Ptr)

3434test7 : Ptr -> Int -> IO Int

3535test7 fnptr i = foreign FFI_C "%dynamic" (Ptr -> Int -> IO Int) fnptr i

3636

37+adder : Int -> Int -> ()

38+adder x y = unsafePerformIO $ do

39+ printLn $ x + y

40+

41+test8 : IO ()

42+test8 = foreign FFI_C "test_mulpar" (CFnPtr (Int -> Int -> ()) -> IO ())

43+ (MkCFnPtr adder)

44+

3745main : IO ()

3846main = do

3947 test

@@ -46,4 +54,5 @@ main = do

4654 fptr <- test6

4755 i <- test7 fptr 3

4856 printLn i

57+ test8

4958 return ()