[Pkg-ocaml-maint-commits] [ocaml-ctypes] 01/02: Fix for PowerPC: handle libffi's integer return type promotion
Stéphane Glondu
glondu at moszumanska.debian.org
Sat Jun 18 14:16:26 UTC 2016
This is an automated email from the git hooks/post-receive script.
glondu pushed a commit to branch master
in repository ocaml-ctypes.
commit 8c0ca336ef1095f3b062c7f6ead9bce3d31f50a3
Author: Stephane Glondu <steph at glondu.net>
Date: Sat Jun 18 16:03:18 2016 +0200
Fix for PowerPC: handle libffi's integer return type promotion
---
...erPC-handle-libffi-s-integer-return-type-.patch | 196 +++++++++++++++++++++
debian/patches/series | 1 +
2 files changed, 197 insertions(+)
diff --git a/debian/patches/0002-Fix-for-PowerPC-handle-libffi-s-integer-return-type-.patch b/debian/patches/0002-Fix-for-PowerPC-handle-libffi-s-integer-return-type-.patch
new file mode 100644
index 0000000..3857339
--- /dev/null
+++ b/debian/patches/0002-Fix-for-PowerPC-handle-libffi-s-integer-return-type-.patch
@@ -0,0 +1,196 @@
+From: Stephane Glondu <steph at glondu.net>
+Date: Sat, 18 Jun 2016 16:01:07 +0200
+Subject: Fix for PowerPC: handle libffi's integer return type promotion
+
+Origin: https://github.com/ocamllabs/ocaml-ctypes/pull/405
+Bug: https://github.com/ocamllabs/ocaml-ctypes/issues/404
+---
+ src/ctypes-foreign-base/ffi_call_stubs.c | 51 ++++++++++++++++++++++++----
+ tests/clib/test_functions.c | 5 +++
+ tests/clib/test_functions.h | 1 +
+ tests/test-higher_order/stubs/functions.ml | 3 ++
+ tests/test-higher_order/test_higher_order.ml | 14 ++++++++
+ 5 files changed, 68 insertions(+), 6 deletions(-)
+
+diff --git a/src/ctypes-foreign-base/ffi_call_stubs.c b/src/ctypes-foreign-base/ffi_call_stubs.c
+index 604d174..af5f214 100644
+--- a/src/ctypes-foreign-base/ffi_call_stubs.c
++++ b/src/ctypes-foreign-base/ffi_call_stubs.c
+@@ -114,6 +114,17 @@ static struct callspec {
+ /* return value offset */
+ size_t roffset;
+
++ /* return offset adjustment.
++
++ libffi promotes return types that are less than the size of the
++ system register to the word-sized type ffi_arg. On a big-endian
++ system this means that the address where libffi writes the return
++ value is not always the same as the address from which ctypes
++ should read the value.
++ */
++ size_t radjustment;
++
++
+ /* The context in which the call should run: whether errno is
+ checked, whether the runtime lock is released, and so on. */
+ struct call_context {
+@@ -129,7 +140,7 @@ static struct callspec {
+ ffi_cif *cif;
+
+ } callspec_prototype = {
+- 0, 0, 0, 0, BUILDING, NULL, -1, { 0, 0 }, NULL
++ 0, 0, 0, 0, BUILDING, NULL, -1, 0, { 0, 0 }, NULL
+ };
+
+
+@@ -246,6 +257,31 @@ value ctypes_add_argument(value callspec_, value argument_)
+ }
+
+
++static int ffi_return_type_adjustment(ffi_type *f)
++{
++#ifdef ARCH_BIG_ENDIAN
++ /* An adjustment is needed (on bigendian systems) for integer types
++ less than the size of a word */
++ if (f->size < sizeof(ffi_arg)) {
++ switch (f->type) {
++ case FFI_TYPE_INT:
++ case FFI_TYPE_UINT8:
++ case FFI_TYPE_SINT8:
++ case FFI_TYPE_UINT16:
++ case FFI_TYPE_SINT16:
++ case FFI_TYPE_UINT32:
++ case FFI_TYPE_SINT32:
++ case FFI_TYPE_UINT64:
++ case FFI_TYPE_SINT64:
++ return sizeof(ffi_arg) - f->size;
++ default: break;
++ }
++ }
++#endif
++ return 0;
++}
++
++
+ /* Pass the return type and conclude the specification preparation */
+ /* prep_callspec : callspec -> 'a ffitype -> int -> unit */
+ value ctypes_prep_callspec(value callspec_, value abi_, value rtype)
+@@ -262,9 +298,11 @@ value ctypes_prep_callspec(value callspec_, value abi_, value rtype)
+ /* Add the (aligned) space needed for the return value */
+ callspec->roffset = aligned_offset(callspec->bytes,
+ rffitype->alignment);
++ callspec->radjustment = ffi_return_type_adjustment(rffitype);
+ callspec->bytes = callspec->roffset + rffitype->size;
+
+- /* Allocate an extra word after the return value space to work
++
++ /* Allocate an extra word after the return value space, to work
+ around a bug in libffi which causes it to write past the return
+ value space.
+
+@@ -308,7 +346,8 @@ value ctypes_call(value fnname, value function, value callspec_,
+ size_t bytes = compute_arg_buffer_size(callspec, &arg_array_offset);
+
+ char *callbuffer = alloca(bytes);
+- char *return_slot = callbuffer + roffset;
++ char *return_write_slot = callbuffer + roffset;
++ char *return_read_slot = return_write_slot + callspec->radjustment;
+
+ populate_arg_array(callspec, (struct callbuffer *)callbuffer,
+ (void **)(callbuffer + arg_array_offset));
+@@ -350,7 +389,7 @@ value ctypes_call(value fnname, value function, value callspec_,
+
+ ffi_call(cif,
+ cfunction,
+- return_slot,
++ return_write_slot,
+ (void **)(callbuffer + arg_array_offset));
+ if (check_errno)
+ {
+@@ -369,7 +408,7 @@ value ctypes_call(value fnname, value function, value callspec_,
+ unix_error(saved_errno, buffer, Nothing);
+ }
+
+- callback_rv_buf = CTYPES_FROM_PTR(return_slot);
++ callback_rv_buf = CTYPES_FROM_PTR(return_read_slot);
+ CAMLreturn(caml_callback(rvreader, callback_rv_buf));
+ }
+
+@@ -423,7 +462,7 @@ static void callback_handler_with_lock(ffi_cif *cif,
+
+ /* now store the return value */
+ assert (Tag_val(boxedfn) == Done);
+- argptr = CTYPES_FROM_PTR(ret);
++ argptr = CTYPES_FROM_PTR(ret + ffi_return_type_adjustment(cif->rtype));
+ caml_callback(Field(boxedfn, 0), argptr);
+
+ CAMLreturn0;
+diff --git a/tests/clib/test_functions.c b/tests/clib/test_functions.c
+index 12501cb..23cb093 100644
+--- a/tests/clib/test_functions.c
++++ b/tests/clib/test_functions.c
+@@ -637,3 +637,8 @@ int return_10(void)
+ {
+ return 10;
+ }
++
++int callback_returns_char_a(char (*f)(void))
++{
++ return f() == 'a' ? 1 : 0;
++}
+diff --git a/tests/clib/test_functions.h b/tests/clib/test_functions.h
+index 7928acd..34d41f0 100644
+--- a/tests/clib/test_functions.h
++++ b/tests/clib/test_functions.h
+@@ -234,4 +234,5 @@ void *retrieve_ocaml_value(void);
+ int sixargs(int, int, int, int, int, int);
+ int return_10(void);
+
++int callback_returns_char_a(char (*)(void));
+ #endif /* TEST_FUNCTIONS_H */
+diff --git a/tests/test-higher_order/stubs/functions.ml b/tests/test-higher_order/stubs/functions.ml
+index c4e1f5f..0318f6e 100644
+--- a/tests/test-higher_order/stubs/functions.ml
++++ b/tests/test-higher_order/stubs/functions.ml
+@@ -27,6 +27,9 @@ struct
+ funptr Ctypes.(int @-> int @-> returning int) @->
+ int @-> int @-> returning int)
+
++ let callback_returns_char_a = foreign "callback_returns_char_a"
++ (funptr Ctypes.(void @-> returning char) @-> returning int)
++
+ let returning_funptr = foreign "returning_funptr"
+ (int @-> returning (funptr Ctypes.(int @-> int @-> returning int)))
+
+diff --git a/tests/test-higher_order/test_higher_order.ml b/tests/test-higher_order/test_higher_order.ml
+index 0811bdb..199e2b5 100644
+--- a/tests/test-higher_order/test_higher_order.ml
++++ b/tests/test-higher_order/test_higher_order.ml
+@@ -54,6 +54,14 @@ struct
+ assert_equal 10 (higher_order_3 acceptor ( + ) 3 4);
+ assert_equal 36 (higher_order_3 acceptor ( * ) 3 4)
+
++ (*
++ Call a C function of type
++ int (char( * )(void))
++ and check that the char returned by the function pointer is handled
++ correctly
++ *)
++ let test_function_pointer_returning_char _ =
++ assert_equal 1 (callback_returns_char_a (fun () -> 'a'))
+
+ (*
+ Call a C function of type
+@@ -142,6 +150,12 @@ let suite = "Higher-order tests" >:::
+ "test_higher_higher_order (stubs)"
+ >:: Stub_tests.test_higher_higher_order;
+
++ "test_function_pointer_returning_char (stubs)"
++ >:: Stub_tests.test_function_pointer_returning_char;
++
++ "test_function_pointer_returning_char (foreign)"
++ >:: Foreign_tests.test_function_pointer_returning_char;
++
+ "test_returning_pointer_to_function (foreign)"
+ >:: Foreign_tests.test_returning_pointer_to_function;
+
diff --git a/debian/patches/series b/debian/patches/series
index 98d0e0a..1767e8d 100644
--- a/debian/patches/series
+++ b/debian/patches/series
@@ -1 +1,2 @@
0001-Use-the-same-C-compiler-as-OCaml-to-build-test-stubs.patch
+0002-Fix-for-PowerPC-handle-libffi-s-integer-return-type-.patch
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocaml-ctypes.git
More information about the Pkg-ocaml-maint-commits
mailing list