Skip to content

Instantly share code, notes, and snippets.

@yallop
Last active June 23, 2018 17:45
Show Gist options
  • Save yallop/d196fee1607883493876 to your computer and use it in GitHub Desktop.
Save yallop/d196fee1607883493876 to your computer and use it in GitHub Desktop.
Ctypes inverted stubs with a struct of callbacks

Using (ocaml-)ctypes to build a shared library involving structs of function pointers. See the thread on the ctypes mailing list for background.

Contents:

You'll need an OCaml distribution compile to position-independent code and the ctypes library. OPAM users can install the prerequisites by issuing the following commands:

opam switch 4.01.0+PIC
eval `opam config env`
opam install ctypes

Once everything's installed you can build the library and run the test as follows:

chmod +x build.sh
./build.sh
LD_LIBRARY_PATH=. ./client
open Ctypes
let callbacks : [`callback] structure typ = structure "callbacks"
let arith = field callbacks "arith" (Foreign.funptr (int @-> int @-> returning int))
let print = field callbacks "print" (Foreign.funptr (string @-> returning void))
let () = seal callbacks
type state = { arith: int -> int -> int; print: string -> unit }
let cache : ([`callback] structure * state) list ref = ref []
let build id =
let state = { arith = (+);
print = Printf.printf "id: %d; msg: %s\n%!" id } in
let c = make callbacks in
begin
setf c arith state.arith;
setf c print state.print;
cache := (c, state) :: !cache;
addr c
end
module Bindings(I: Cstubs_inverted.INTERNAL) =
struct
let _ = I.internal "build" (int @-> returning (ptr callbacks)) build
end
#!/bin/bash -xe
# compile the bindings and the code generator
ocamlfind opt -c -package ctypes.stubs,ctypes.foreign bindings.ml gen.ml
# link and run the code generator
ocamlfind opt -linkpkg -package ctypes.stubs,ctypes.foreign \
bindings.cmx gen.cmx -o gen
./gen
# compile the generated code
ocamlfind opt -c -package ctypes.stubs,ctypes.foreign \
-I $(ocamlfind query ctypes)/.. callbacks.ml load.ml callback_stubs.c
# build a shared library
ocamlfind opt -g -o libcallbacks.so -linkpkg -output-obj \
-package ctypes.stubs,ctypes.foreign \
bindings.cmx callbacks.cmx load.cmx callback_stubs.o
# build a test client
gcc -g -ansi -Wall -c -o client.o client.c
gcc -o client -g client.o -L. -lcallbacks
#include "callback_stubs.h"
#include <caml/callback.h>
#include <stdio.h>
int main(int argc, char **argv)
{
/* Initialize the OCaml runtime before calling the library. */
char *caml_argv[1] = { NULL };
caml_startup(caml_argv);
struct callbacks *c0 = build(0);
struct callbacks *c1 = build(1);
printf("c0->arith(10, 20) => %d\n", c0->arith(10, 20));
printf("c1->arith(30, 40) => %d\n", c0->arith(30, 40));
c0->print("printing via c0");
c1->print("printing via c1");
return 0;
}
open Format
let with_formatter filename f =
let fd = open_out filename in
let fmt = formatter_of_out_channel fd in
f fmt;
close_out fd
let prefix = "callback"
let () =
begin
with_formatter "callback_stubs.h"
(fun fmt ->
Ctypes.format_typ fmt Bindings.callbacks;
fprintf fmt ";\n";
Cstubs_inverted.write_c_header fmt ~prefix (module Bindings.Bindings)
);
with_formatter "callback_stubs.c"
(fun fmt ->
fprintf fmt "#include \"callback_stubs.h\"\n";
Cstubs_inverted.write_c fmt ~prefix (module Bindings.Bindings)
);
with_formatter "callbacks.ml"
(fun fmt ->
Cstubs_inverted.write_ml fmt ~prefix (module Bindings.Bindings)
);
end
module M = Bindings.Bindings(Callbacks)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment