Skip to content

Commit

Permalink
Merge pull request #1 from yallop/add-dynamic-funptr-type-review
Browse files Browse the repository at this point in the history
Thank you very much!
  • Loading branch information
tiash authored Dec 6, 2019
2 parents 23802e6 + a928781 commit d0cd550
Show file tree
Hide file tree
Showing 8 changed files with 120 additions and 98 deletions.
4 changes: 2 additions & 2 deletions src/ctypes-foreign-base/ctypes_ffi.ml
Original file line number Diff line number Diff line change
Expand Up @@ -269,9 +269,9 @@ struct
"WARN: a ctypes function pointer was not explicitly released.\n\
Releasing a function pointer or the associated OCaml closure while \n\
the function pointer is still in use from C will cause segmentation faults.\n\
Please call [Foreign.free_funptr] explicitly when the funptr is no longer needed.\n\
Please call [Foreign.Funptr.free] explicitly when the funptr is no longer needed.\n\
To avoid a segmentation fault we are preventing this funptr from\n\
being garbage collected. Please use [Foreign.free_funptr].\n%!")) t;
being garbage collected. Please use [Foreign.Funptr.free].\n%!")) t;
t

let funptr_of_fun ~abi ~acquire_runtime_lock ~thread_registration fn =
Expand Down
5 changes: 3 additions & 2 deletions src/ctypes-foreign-base/ctypes_ffi.mli
Original file line number Diff line number Diff line change
Expand Up @@ -42,8 +42,9 @@ sig

val free_funptr : _ funptr -> unit

val funptr_of_fun : abi:abi -> acquire_runtime_lock:bool -> thread_registration:bool
-> ('a -> 'b) fn -> ('a -> 'b) -> ('a -> 'b) funptr
val funptr_of_fun : abi:abi -> acquire_runtime_lock:bool ->
thread_registration:bool ->
('a -> 'b) fn -> ('a -> 'b) -> ('a -> 'b) funptr

val funptr_of_static_funptr : ('a -> 'b) static_funptr -> ('a -> 'b) funptr

Expand Down
7 changes: 5 additions & 2 deletions src/ctypes-foreign-base/ctypes_foreign_basis.ml
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,9 @@ struct
val with_fun : fn -> (t -> 'c) -> 'c
end

let dynamic_funptr (type a b) ?(abi=Libffi_abi.default_abi) ?(runtime_lock=false) ?(thread_registration=false) fn : (module Funptr with type fn = a -> b) =
let dynamic_funptr (type a) (type b) ?(abi=Libffi_abi.default_abi)
?(runtime_lock=false) ?(thread_registration=false) fn
: (module Funptr with type fn = a -> b) =
(module struct
type fn = a -> b
type t = fn Ffi.funptr
Expand All @@ -70,7 +72,8 @@ struct

let t_opt = Ctypes_std_views.nullable_funptr_view t fn
let free = Ffi.free_funptr
let of_fun = Ffi.funptr_of_fun ~abi ~acquire_runtime_lock:runtime_lock ~thread_registration fn
let of_fun = Ffi.funptr_of_fun ~abi ~acquire_runtime_lock:runtime_lock
~thread_registration fn

let with_fun f do_it =
let f = of_fun f in
Expand Down
83 changes: 44 additions & 39 deletions src/ctypes-foreign-threaded/foreign.mli
Original file line number Diff line number Diff line change
Expand Up @@ -56,14 +56,6 @@ val funptr :
('a -> 'b) Ctypes.typ
(** Construct a function pointer type from a function type.
----
This function ties the lifetime of the C funtion to the associated OCaml closure.
An alternative with explicity lifetime management is {!dynamic_funptr}
----
The ctypes library, like C itself, distinguishes functions and function
pointers. Functions are not first class: it is not possible to use them
as arguments or return values of calls, or store them in addressable
Expand All @@ -83,7 +75,15 @@ val funptr :
should be acquired and held during the call.
@raise Dl.DL_error if [name] is not found in [?from] and [?stub] is
[false]. *)
[false].
A note on lifetime: this function ties the lifetime of the C function to
the associated OCaml closure, so that the C function may be used only
while the closure is still live.
The {!dynamic_funptr} function is an alternative to {funptr} with explicit
lifetime management.
*)

val funptr_opt :
?abi:Libffi_abi.abi ->
Expand All @@ -107,47 +107,48 @@ module type Funptr = sig
(** [fn] is the signature of the underlying OCaml function. *)

type t
(** Handle to an OCaml function that can be passed to C for use in callbacks.
(** Handle to an OCaml function that can be passed to C for use in
callbacks.
Each value of type {!t} allocated by {!of_fun} must be deallocated by calling {!free}.
Alternatively {!with_fun} encapsulates both allocation and deallocation. *)
Each value of type {!t} allocated by {!of_fun} must be deallocated by
calling {!free}. Alternatively {!with_fun} encapsulates both allocation
and deallocation. *)

val t : t Ctypes.typ
(** A type representation for a function pointer type with explicit lifetime management. *)
(** A type representation for a function pointer type with explicit lifetime
management. *)

val t_opt : t option Ctypes.typ
(** This behaves like {!t}, except that null pointers appear in OCaml as [None]. *)

val free : t -> unit
(** Indicate that the [fptr] is no longer needed.
Once [free] has been called any C calls to this [Funptr.t] are
Once [free] has been called any C calls to this [Dynamic_funptr.t] are
unsafe. Only call [free] once the callback is no longer used from C. *)

val of_fun : fn -> t
(** Turn an OCaml closure into a function pointer that can be passed to C.
You MUST call {!free} when the function pointer is no longer needed.
Failure to do so will result in a memory leak.
The function pointer returned by [of_fun] should be deallocated by a
call to {!free} once it is no longer in use. Failure to call {!free} is
an error.
Failure to call {!free} and not holding a reference this this pointer
is an error.
Alternatively, {!with_fun} encapsulates both allocation and
deallocation.
Alternatively {!with_fun} encapsulates both allocation and deallocation.
Implementation detail: To avoid hard to debug crashes the implementation
will leak the OCaml closure in this event that {!free} was not used and
report a warning, see {!on_leaked_funptr}. *)
Implementation detail: to avoid crashes, if {!free} is not called then
the implementation will retain a reference to the OCaml closure and
report a warning. See {!report_leaked_funptr}. *)

val with_fun : fn -> (t -> 'c) -> 'c
(** [with_fun fn (fun fptr -> DO_STUFF)] - Turn an OCaml closure into a
function pointer and do simple life cycle management.
(** [with_fun fn (fun fptr -> e)] - Turn an OCaml closure into a function
pointer and perform simple life cycle management.
This will automatically call [free fptr] after [DO_STUFF] completes.
[with_fun fn (fun fptr -> e)] will call [free fptr] after [e] completes.
[with_fun] is not safe to use if the C function ptr [fptr] may still be used
after [DO_STUFF] completes.
*)
[with_fun] is not safe to use if the C function ptr [fptr] may still be
used after [e] completes. *)
end

val dynamic_funptr
Expand All @@ -156,16 +157,18 @@ val dynamic_funptr
-> ?thread_registration:bool
-> ('a -> 'b) Ctypes.fn
-> (module Funptr with type fn = 'a->'b)
(** Define a type representation for more safely passing OCaml functions to C.
(** Define a type representation for passing OCaml functions to C with
explicit lifetime management.
[(val (dynamic_funptr (FOO @-> returning BAR)))] is roughly equivalent to
[BAR( * )(FOO)] in C.
[(val (dynamic_funptr (foo @-> returning bar)))] corresponds to
the C type [bar( * )(foo)].
Example:
{[
module Progress_callback = (val (dynamic_funptr (int @-> int @-> ptr void @-> returning void)))
let keygen =
foreign "RSA_generate_key" (int @-> int @-> Progress_callback.t @-> ptr void @-> returning rsa_key)
module Progress_callback =
(val (dynamic_funptr (int @-> int @-> ptr void @-> returning void)))
let keygen = foreign "RSA_generate_key"
(int @-> int @-> Progress_callback.t @-> ptr void @-> returning rsa_key)
let secret_key =
Progress_callback.with_fun
(fun a b _ -> printf "progress: a:%d, b:%d\n" a b)
Expand All @@ -175,9 +178,11 @@ val dynamic_funptr
*)

val report_leaked_funptr : (string -> unit) ref
(** Hook for setting custom handling for leaked non-{!free}d {!dynamic_funptr}s.
(** Hook called on collection of closures associated with
{!dynamic_funptr} values that have not been deallocated with {!free}.
By default the library will retain function pointers that have not been freed and
print an warning to stderr.
By default the ctypes library retains closures associated with function
pointers that have not been freed and prints a warning to stderr.
You can use this hook to change how these error messages are reported. *)
You can use this hook to change how these error messages are reported.
*)
81 changes: 43 additions & 38 deletions src/ctypes-foreign-unthreaded/foreign.mli
Original file line number Diff line number Diff line change
Expand Up @@ -56,14 +56,6 @@ val funptr :
('a -> 'b) Ctypes.typ
(** Construct a function pointer type from a function type.
----
This function ties the lifetime of the C funtion to the associated OCaml closure.
An alternative with explicity lifetime management is {!dynamic_funptr}
----
The ctypes library, like C itself, distinguishes functions and function
pointers. Functions are not first class: it is not possible to use them
as arguments or return values of calls, or store them in addressable
Expand All @@ -83,7 +75,15 @@ val funptr :
should be acquired and held during the call.
@raise Dl.DL_error if [name] is not found in [?from] and [?stub] is
[false]. *)
[false].
A note on lifetime: this function ties the lifetime of the C function to
the associated OCaml closure, so that the C function may be used only
while the closure is still live.
The {!dynamic_funptr} function is an alternative to {funptr} with explicit
lifetime management.
*)

val funptr_opt :
?abi:Libffi_abi.abi ->
Expand All @@ -107,13 +107,16 @@ module type Funptr = sig
(** [fn] is the signature of the underlying OCaml function. *)

type t
(** Handle to an OCaml function that can be passed to C for use in callbacks.
(** Handle to an OCaml function that can be passed to C for use in
callbacks.
Each value of type {!t} allocated by {!of_fun} must be deallocated by calling {!free}.
Alternatively {!with_fun} encapsulates both allocation and deallocation. *)
Each value of type {!t} allocated by {!of_fun} must be deallocated by
calling {!free}. Alternatively {!with_fun} encapsulates both allocation
and deallocation. *)

val t : t Ctypes.typ
(** A type representation for a function pointer type with explicit lifetime management. *)
(** A type representation for a function pointer type with explicit lifetime
management. *)

val t_opt : t option Ctypes.typ
(** This behaves like {!t}, except that null pointers appear in OCaml as [None]. *)
Expand All @@ -127,27 +130,25 @@ module type Funptr = sig
val of_fun : fn -> t
(** Turn an OCaml closure into a function pointer that can be passed to C.
You MUST call {!free} when the function pointer is no longer needed.
Failure to do so will result in a memory leak.
The function pointer returned by [of_fun] should be deallocated by a
call to {!free} once it is no longer in use. Failure to call {!free} is
an error.
Failure to call {!free} and not holding a reference this this pointer
is an error.
Alternatively, {!with_fun} encapsulates both allocation and
deallocation.
Alternatively {!with_fun} encapsulates both allocation and deallocation.
Implementation detail: To avoid hard to debug crashes the implementation
will leak the OCaml closure in this event that {!free} was not used and
report a warning, see {!on_leaked_funptr}. *)
Implementation detail: to avoid crashes, if {!free} is not called then
the implementation will retain a reference to the OCaml closure and
report a warning. See {!report_leaked_funptr}. *)

val with_fun : fn -> (t -> 'c) -> 'c
(** [with_fun fn (fun fptr -> DO_STUFF)] - Turn an OCaml closure into a
function pointer and do simple life cycle management.
(** [with_fun fn (fun fptr -> e)] - Turn an OCaml closure into a function
pointer and perform simple life cycle management.
This will automatically call [free fptr] after [DO_STUFF] completes.
[with_fun fn (fun fptr -> e)] will call [free fptr] after [e] completes.
[with_fun] is not safe to use if the C function ptr [fptr] may still be used
after [DO_STUFF] completes.
*)
[with_fun] is not safe to use if the C function ptr [fptr] may still be
used after [e] completes. *)
end

val dynamic_funptr
Expand All @@ -156,16 +157,18 @@ val dynamic_funptr
-> ?thread_registration:bool
-> ('a -> 'b) Ctypes.fn
-> (module Funptr with type fn = 'a->'b)
(** Define a type representation for more safely passing OCaml functions to C.
(** Define a type representation for passing OCaml functions to C with
explicit lifetime management.
[(val (dynamic_funptr (FOO @-> returning BAR)))] is roughly equivalent to
[BAR( * )(FOO)] in C.
[(val (dynamic_funptr (foo @-> returning bar)))] corresponds to
the C type [bar( * )(foo)].
Example:
{[
module Progress_callback = (val (dynamic_funptr (int @-> int @-> ptr void @-> returning void)))
let keygen =
foreign "RSA_generate_key" (int @-> int @-> Progress_callback.t @-> ptr void @-> returning rsa_key)
module Progress_callback =
(val (dynamic_funptr (int @-> int @-> ptr void @-> returning void)))
let keygen = foreign "RSA_generate_key"
(int @-> int @-> Progress_callback.t @-> ptr void @-> returning rsa_key)
let secret_key =
Progress_callback.with_fun
(fun a b _ -> printf "progress: a:%d, b:%d\n" a b)
Expand All @@ -175,9 +178,11 @@ val dynamic_funptr
*)

val report_leaked_funptr : (string -> unit) ref
(** Hook for setting custom handling for leaked non-{!free}d {!dynamic_funptr}s.
(** Hook called on collection of closures associated with
{!dynamic_funptr} values that have not been deallocated with {!free}.
By default the library will retain function pointers that have not been freed and
print an warning to stderr.
By default the ctypes library retains closures associated with function
pointers that have not been freed and prints a warning to stderr.
You can use this hook to change how these error messages are reported. *)
You can use this hook to change how these error messages are reported.
*)
8 changes: 4 additions & 4 deletions tests/clib/test_functions.c
Original file line number Diff line number Diff line change
Expand Up @@ -894,8 +894,8 @@ int foreign_thread_registration_test(void (*test_f)(uint64_t),
return ret_code;
}

int call_dynamic_funptr(int (*f)(int),int n) {
if(f == NULL) return 0;
int call_dynamic_funptr(int (*f)(int), int n) {
if (f == NULL) return 0;
else return f(n);
}

Expand All @@ -909,5 +909,5 @@ int call_saved_dynamic_funptr(int n) {
return call_dynamic_funptr(saved_dynamic_funptr, n);
}

int call_dynamic_funptr_struct(struct simple_closure x) { return (x.f(x.n)); }
int call_dynamic_funptr_struct_ptr(struct simple_closure *x) { return (x->f(x->n)); }
int call_dynamic_funptr_struct(struct simple_closure x) { return x.f(x.n); }
int call_dynamic_funptr_struct_ptr(struct simple_closure *x) { return x->f(x->n); }
22 changes: 14 additions & 8 deletions tests/test-funptrs/stubs/functions.ml
Original file line number Diff line number Diff line change
Expand Up @@ -6,19 +6,25 @@ module Stubs (F: Ctypes.FOREIGN) =
struct
open F

let call_dynamic_funptr = foreign "call_dynamic_funptr" (Callback.t @-> int @-> returning int)
let save_dynamic_funptr = foreign "save_dynamic_funptr" (Callback.t @-> returning void)
let call_saved_dynamic_funptr = foreign "call_saved_dynamic_funptr" (int @-> returning int)

let call_dynamic_funptr_opt = foreign "call_dynamic_funptr" (Callback.t_opt @-> int @-> returning int)
let save_dynamic_funptr_opt = foreign "save_dynamic_funptr" (Callback.t_opt @-> returning void)
let call_dynamic_funptr = foreign "call_dynamic_funptr"
(Callback.t @-> int @-> returning int)
let save_dynamic_funptr = foreign "save_dynamic_funptr"
(Callback.t @-> returning void)
let call_saved_dynamic_funptr = foreign "call_saved_dynamic_funptr"
(int @-> returning int)
let call_dynamic_funptr_opt = foreign "call_dynamic_funptr"
(Callback.t_opt @-> int @-> returning int)
let save_dynamic_funptr_opt = foreign "save_dynamic_funptr"
(Callback.t_opt @-> returning void)

type simple_closure
let simple_closure : simple_closure structure typ = structure "simple_closure"
let simple_closure_f = field simple_closure "f" Callback.t
let simple_closure_n = field simple_closure "n" int
let () = seal simple_closure

let call_dynamic_funptr_struct = foreign "call_dynamic_funptr_struct" (simple_closure @-> returning int)
let call_dynamic_funptr_struct_ptr = foreign "call_dynamic_funptr_struct_ptr" (ptr simple_closure @-> returning int)
let call_dynamic_funptr_struct = foreign "call_dynamic_funptr_struct"
(simple_closure @-> returning int)
let call_dynamic_funptr_struct_ptr = foreign "call_dynamic_funptr_struct_ptr"
(ptr simple_closure @-> returning int)
end
Loading

0 comments on commit d0cd550

Please sign in to comment.