matthieu/ocaml-libusb
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Commit initial

Browse Source
This commit is contained in:
Matthieu Dubuget
2018-06-07 14:31:53 +02:00
commit b7376530ea
16 changed files with 506 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
lib/generator/g.ml Normal file
View File

@ -0,0 +1,21 @@
open Ctypes
module U = T.Types(My_types)
module P(F:Cstubs.FOREIGN) = struct
open F
let error_name = foreign "libusb_error_name" (U.error @-> returning string)
let error_description = foreign "libusb_strerror" (U.error @-> returning string)
let init = foreign "libusb_init" (ptr void @-> returning U.error)
let exit = foreign "libusb_exit" (ptr void @-> returning void)
let get_version = foreign "libusb_get_version" (void @-> returning (ptr U.version))
let get_device_list = foreign "libusb_get_device_list" (ptr void @-> ptr (ptr (ptr U.device)) @-> returning U.error)
let free_device_list = foreign "libusb_free_device_list" (ptr (ptr U.device) @-> int @-> returning void)
let unref_device = foreign "libusb_unref_device" (ptr U.device @-> returning void)
let open_device = foreign "libusb_open" (ptr U.device @-> ptr (ptr U.device_handle) @-> returning U.error)
let close_device = foreign "libusb_close" (ptr U.device_handle @-> returning void)
let get_device_descriptor = foreign "libusb_get_device_descriptor" (ptr U.device @-> ptr U.device_descriptor @-> returning U.error)
let get_string_descriptor_ascii = foreign "libusb_get_string_descriptor_ascii" (ptr U.device_handle @-> uint8_t @-> ptr char @-> int @-> returning U.error)
let control_transfer = foreign "libusb_control_transfer" (ptr U.device_handle @-> uint8_t @-> uint8_t @-> uint16_t @-> uint16_t @-> ptr char @-> uint16_t @-> uint @-> returning U.error)
let bulk_transfer = foreign "libusb_bulk_transfer" (ptr U.device_handle @-> uint8_t @-> ptr char @-> int @-> ptr int @-> uint @-> returning U.error)
end

16
lib/generator/generator.ml Normal file
View File

@ -0,0 +1,16 @@
open G
let () =
(*** C part ***)
let oc = open_out "cstub_libusb.c" in
let cstub = Format.formatter_of_out_channel oc in
Format.fprintf cstub "#include <libusb.h>\n";
Cstubs.write_c cstub "libusb" (module P);
close_out oc;
(*** ML part ***)
let oc = open_out "bindings.ml" in
let bindings = Format.formatter_of_out_channel oc in
Cstubs.write_ml bindings "libusb" (module P);
close_out oc

6
lib/generator/jbuild Normal file
View File

@ -0,0 +1,6 @@
(executable(
(name generator)
(libraries (ctypes.stubs))
))
(copy_files stubs/{t,my_types}.ml)

3
lib/generator/stubs/c_types_generator/c_types_generator.ml Normal file
View File

@ -0,0 +1,3 @@
let () =
Format.fprintf Format.std_formatter "#include <libusb.h>@.";
Cstubs.Types.write_c Format.std_formatter (module T.Types)

9
lib/generator/stubs/c_types_generator/jbuild Normal file
View File

@ -0,0 +1,9 @@
(executable(
(name c_types_generator)
(libraries (ctypes.stubs))
))
(rule(
(targets (t.ml))
(action (copy ../t.ml t.ml))
))

5
lib/generator/stubs/ctypes_cflags_generator/ctypes_cflags_generator.ml Normal file
View File

@ -0,0 +1,5 @@
Printf.printf "-I%s%!"
(
Findlib.init ();
Findlib.package_directory "ctypes"
)

4
lib/generator/stubs/ctypes_cflags_generator/jbuild Normal file
View File

@ -0,0 +1,4 @@
(executable(
(name ctypes_cflags_generator)
(libraries (findlib))
))

36
lib/generator/stubs/jbuild Normal file
View File

@ -0,0 +1,36 @@
(rule(
(targets (my_types.ml))
(deps (my_types_generator.exe))
(action (with-stdout-to ${@} (run ${<})))
))
(rule(
(targets (my_types_generator.exe))
(deps (my_types_generator.c))
(action (run ${CC}
-o ${@}
${read:libusb_cflags}
${read:ctypes_cflags}
-I${ocaml-config:standard_library}
${<}))
))
(rule(
(targets (my_types_generator.c))
(action
(with-stdout-to ${@}
(run c_types_generator/c_types_generator.exe)
))
))
(rule(
(targets (ctypes_cflags))
(action (with-stdout-to ${@}
(run ctypes_cflags_generator/ctypes_cflags_generator.exe)))
))
(rule(
(targets (libusb_cflags))
(action (with-stdout-to ${@}
(run libusb_cflags_generator/libusb_cflags_generator.exe)))
))

4
lib/generator/stubs/libusb_cflags_generator/jbuild Normal file
View File

@ -0,0 +1,4 @@
(executable(
(name libusb_cflags_generator)
(libraries (configurator))
))

14
lib/generator/stubs/libusb_cflags_generator/libusb_cflags_generator.ml Normal file
View File

@ -0,0 +1,14 @@
let (>>|) a f = match a with None -> None | Some a -> f a
let libusb_c_flags =
let open Configurator in
create "c"
|> Pkg_config.get
>>| Pkg_config.query ~package:"libusb-1.0"
>>| (fun Pkg_config.{cflags} ->
Some (String.concat " " cflags))
|> (function
| None -> "libusb flag not found"
| Some f -> f)
let () = Printf.printf "%s%!" libusb_c_flags

117
lib/generator/stubs/t.ml Normal file
View File

@ -0,0 +1,117 @@
open Ctypes
type error =
| Number of int (** A positive number *)
| Success (** Success (no error) *)
| Error_io (** Input/output error *)
| Error_invalid_param (** Invalid parameter *)
| Error_access (** Access denied (insufficient permissions) *)
| Error_no_device (** No such device (it may have been disconnected) *)
| Error_not_found (** Entity not found *)
| Error_busy (** Resource busy *)
| Error_timeout (** Operation timed out *)
| Error_overflow (** Overflow *)
| Error_pipe (** Pipe error *)
| Error_interrupted (** System call interrupted (perhaps due to signal) *)
| Error_no_mem (** Insufficient memory *)
| Error_not_supported (** Operation not supported or unimplemented on this platform *)
| Error_other (** Other error *)
type version = {
major: int; (** Library major version *)
minor: int; (** Library major version *)
micro: int; (** Library micro version *)
nano: int; (** Library nano version *)
rc: string; (** Library release candidate suffix string, e.g. "-rc4" *)
describe: string; (** For ABI compatibility only *)
}
type device_descriptor = {
id_vendor: int; (** Vendor ID. *)
id_product: int; (** Product ID.*)
i_manufacturer: int; (** Index of string descriptor describing manufacturer. *)
i_product: int; (** Index of string descriptor describing product. *)
}
module Types(T:Cstubs.Types.TYPE) = struct
let success = T.constant "LIBUSB_SUCCESS" T.int64_t
let error_io = T.constant "LIBUSB_ERROR_IO" T.int64_t
let error_invalid_param = T.constant "LIBUSB_ERROR_INVALID_PARAM" T.int64_t
let error_access = T.constant "LIBUSB_ERROR_ACCESS" T.int64_t
let error_no_device = T.constant "LIBUSB_ERROR_NO_DEVICE" T.int64_t
let error_not_found = T.constant "LIBUSB_ERROR_NOT_FOUND" T.int64_t
let error_busy = T.constant "LIBUSB_ERROR_BUSY" T.int64_t
let error_timeout = T.constant "LIBUSB_ERROR_TIMEOUT" T.int64_t
let error_overflow = T.constant "LIBUSB_ERROR_OVERFLOW" T.int64_t
let error_pipe = T.constant "LIBUSB_ERROR_PIPE" T.int64_t
let error_interrupted = T.constant "LIBUSB_ERROR_INTERRUPTED" T.int64_t
let error_no_mem = T.constant "LIBUSB_ERROR_NO_MEM" T.int64_t
let error_not_supported = T.constant "LIBUSB_ERROR_NOT_SUPPORTED" T.int64_t
let error_other = T.constant "LIBUSB_ERROR_OTHER" T.int64_t
let error = T.enum "libusb_error" [
Success, success;
Error_io, error_io;
Error_invalid_param, error_invalid_param ;
Error_access, error_access ;
Error_no_device, error_no_device ;
Error_not_found, error_not_found;
Error_busy, error_busy ;
Error_timeout, error_timeout;
Error_overflow, error_overflow;
Error_pipe, error_pipe ;
Error_interrupted, error_interrupted;
Error_no_mem, error_no_mem ;
Error_not_supported, error_not_supported;
Error_other, error_other ;
] ~unexpected:(fun x -> Number (Int64.to_int x))
let request_type_standard = T.constant "LIBUSB_REQUEST_TYPE_STANDARD" T.int64_t
let request_type_class = T.constant "LIBUSB_REQUEST_TYPE_CLASS" T.int64_t
let request_type_vendor = T.constant "LIBUSB_REQUEST_TYPE_VENDOR" T.int64_t
let request_type_reserved = T.constant "LIBUSB_REQUEST_TYPE_RESERVED" T.int64_t
let endpoint_direction_in = T.constant "LIBUSB_ENDPOINT_IN" T.int64_t
let endpoint_direction_out = T.constant "LIBUSB_ENDPOINT_OUT" T.int64_t
let libusb_recipient_device = T.constant "LIBUSB_RECIPIENT_DEVICE" T.int64_t
let libusb_recipient_interface = T.constant "LIBUSB_RECIPIENT_INTERFACE" T.int64_t
let libusb_recipient_endpoint = T.constant "LIBUSB_RECIPIENT_ENDPOINT" T.int64_t
let libusb_recipient_other = T.constant "LIBUSB_RECIPIENT_OTHER" T.int64_t
type version
let version : version structure typ = structure "libusb_version"
let (|:) n t = field version n t
let version_major = "major" |: uint16_t
let version_minor = "minor" |: uint16_t
let version_micro = "micro" |: uint16_t
let version_nano = "nano" |: uint16_t
let version_rc = "rc" |: string
let version_describe = "describe" |: string
let () = seal version
type device
let device : device structure typ = structure "libusb_device"
type device_handle
let device_handle : device_handle structure typ = structure "libusb_device_handle"
type device_descriptor
let device_descriptor : device_descriptor structure typ = structure "libusb_device_descriptor"
let (|:) n t = field device_descriptor n t
let device_descriptor_blength = "bLength" |: uint8_t (* Size of this descriptor (in bytes) *)
let device_descriptor_bdescriptortype = "bDescriptorType" |: uint8_t (* Descriptor type. *)
let device_descriptor_bcdusb = "bcdUSB" |: uint16_t (* USB specification release number in binary-coded decimal. *)
let device_descriptor_bdeviceclass = "bDeviceClass" |: uint8_t (* USB-IF class code for the device. *)
let device_descriptor_bdevicesubclass = "bDeviceSubClass" |: uint8_t (* USB-IF subclass code for the device, qualified by the bDeviceClass value. *)
let device_descriptor_bdeviceprotocol = "bDeviceProtocol" |: uint8_t (* USB-IF protocol code for the device, qualified by the bDeviceClass and bDeviceSubClass values. *)
let device_descriptor_bmaxpacketsize0 = "bMaxPacketSize0" |: uint8_t (* Maximum packet size for endpoint 0. *)
let device_descriptor_idvendor = "idVendor" |: uint16_t (* USB-IF vendor ID. *)
let device_descriptor_idproduct = "idProduct" |: uint16_t (* USB-IF product ID.*)
let device_descriptor_bcddevice = "bcdDevice" |: uint16_t (* Device release number in binary-coded decimal. *)
let device_descriptor_imanufacturer = "iManufacturer" |: uint8_t (* Index of string descriptor describing manufacturer. *)
let device_descriptor_iproduct = "iProduct" |: uint8_t (* Index of string descriptor describing product. *)
let device_descriptor_iserialnumber = "iSerialNumber" |: uint8_t (* Index of string descriptor containing device serial number. *)
let device_descriptor_bnumconfigurations = "bNumConfigurations" |: uint8_t (* Number of possible configurations. *)
let () = seal device_descriptor
end