├── .gitignore ├── .travis.yml ├── CHANGES.md ├── LICENSE ├── META ├── Makefile ├── README.md ├── _tags ├── lib ├── _tags ├── libmemcpy_stubs.clib ├── memcpy.ml └── memcpy.mli ├── lib_gen ├── _tags ├── memcpy_bindgen.ml └── memcpy_bindings.ml ├── lib_test ├── _tags └── test.ml ├── myocamlbuild.ml └── opam /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | _build 3 | test.native 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: required 3 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh 4 | script: bash -ex .travis-opam.sh 5 | env: 6 | - OCAML_VERSION=4.01 7 | - OCAML_VERSION=4.02 8 | - OCAML_VERSION=4.03 9 | - OCAML_VERSION=4.04 10 | os: 11 | - linux 12 | - osx 13 | matrix: 14 | exclude: 15 | - os: osx 16 | env: OCAML_VERSION=4.01 17 | - os: osx 18 | env: OCAML_VERSION=4.02 19 | - os: osx 20 | env: OCAML_VERSION=4.03 21 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 0.2.2 (2023-07-24): 2 | * ctypes 0.21.0 compatibility 3 | 4 | 0.2.1 (2017-05-23): 5 | * ctypes 0.12.0 compatibility 6 | 7 | 0.2.0 (2017-03-28): 8 | * Add functions `memcpy_from_string` and `memcpy_from_bytes` 9 | * Make `src_off` and `dst_off` optional arguments, defaulting to 0 10 | 11 | 0.1.0 (2016-05-19): 12 | * Initial public release 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Jeremy Yallop 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. -------------------------------------------------------------------------------- /META: -------------------------------------------------------------------------------- 1 | version = "0.2.2" 2 | description = "Ctypes-compatible bindings to memcpy" 3 | requires = "bytes ctypes.stubs" 4 | archive(byte) = "memcpy.cma" 5 | archive(bytes, plugin) = "memcpy.cma" 6 | archive(native) = "memcpy.cmxa" 7 | archive(native, plugin) = "memcpy.cmxs" 8 | exists_if = "memcpy.cma" 9 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: build install uninstall reinstall clean 2 | 3 | FINDLIB_NAME=memcpy 4 | MOD_NAME=memcpy 5 | 6 | OCAML_LIB_DIR=$(shell ocamlc -where) 7 | CTYPES_LIB_DIR=$(shell ocamlfind query ctypes) 8 | 9 | OCAMLBUILD=CTYPES_LIB_DIR=$(CTYPES_LIB_DIR) ocamlbuild -use-ocamlfind -classic-display 10 | 11 | TARGETS=.cma .cmxa 12 | 13 | PRODUCTS=$(addprefix $(MOD_NAME),$(TARGETS)) 14 | PRODUCTS+=$(addprefix $(MOD_NAME),$(TARGETS)) \ 15 | lib$(MOD_NAME)_stubs.a dll$(MOD_NAME)_stubs.so \ 16 | 17 | TYPES=.mli .cmi .cmti .cmx 18 | 19 | INSTALL:=$(addprefix $(MOD_NAME),$(TYPES)) \ 20 | $(addprefix $(MOD_NAME),$(TARGETS)) 21 | 22 | INSTALL:=$(addprefix _build/lib/,$(INSTALL)) 23 | 24 | ARCHIVES:=_build/lib/$(MOD_NAME).a 25 | 26 | ARCHIVES+=_build/lib/$(MOD_NAME).a 27 | 28 | build: 29 | $(OCAMLBUILD) $(PRODUCTS) 30 | 31 | install: 32 | ocamlfind install $(FINDLIB_NAME) META \ 33 | $(INSTALL) \ 34 | -dll _build/lib/dll$(MOD_NAME)_stubs.so \ 35 | -nodll _build/lib/lib$(MOD_NAME)_stubs.a \ 36 | $(ARCHIVES) 37 | 38 | test: build 39 | $(OCAMLBUILD) lib_test/test.native 40 | ./test.native 41 | 42 | uninstall: 43 | ocamlfind remove $(FINDLIB_NAME) 44 | 45 | reinstall: uninstall install 46 | 47 | clean: 48 | ocamlbuild -clean 49 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## ocaml-memcpy 2 | 3 | There are several ways of storing and accessing blocks of memory in an OCaml program, including 4 | 5 | * [`bytes`][bytes] and [`string`][string] values for mutable and immutable strings that reside in the OCaml heap 6 | * [`bigarray`][bigarray] values for reference-counted blocks that reside in the OCaml heaps 7 | * [Ctypes][ocaml-ctypes] [`ptr`][ctypes-pointer] values that can be used to address arbitrary addresses using typed descriptions of the memory layout. 8 | * Ctypes [`carray`][ctypes-array] values that provide bounds-checked access to `ptr`-addressed memory. 9 | 10 | The [`Memcpy` module][memcpy-module] provides functions for safely and efficiently copying blocks of memory between these different representations. 11 | 12 | [string]: http://caml.inria.fr/pub/docs/manual-ocaml/libref/String.html 13 | [bytes]: http://caml.inria.fr/pub/docs/manual-ocaml/libref/Bytes.html 14 | [bigarray]: http://caml.inria.fr/pub/docs/manual-ocaml/libref/Bigarray.html 15 | [ctypes-pointer]: http://ocamllabs.github.io/ocaml-ctypes/Ctypes.html#pointer_types 16 | [ctypes-array]: http://ocamllabs.github.io/ocaml-ctypes/Ctypes.html#4_Carraytypes 17 | [ocaml-ctypes]: https://github.com/ocamllabs/ocaml-ctypes/ 18 | [memcpy-module]: https://github.com/yallop/ocaml-memcpy/blob/master/lib/memcpy.mli 19 | 20 | [![Travis build Status](https://travis-ci.org/yallop/ocaml-memcpy.svg?branch=master)](https://travis-ci.org/yallop/ocaml-memcpy) 21 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true: principal, bin_annot, safe_string, strict_sequence, debug 2 | 3 | "lib": include 4 | -------------------------------------------------------------------------------- /lib/_tags: -------------------------------------------------------------------------------- 1 | true: package(ctypes.stubs) 2 | : use_ctypes 3 | <*.{cma,cmxa}>: use_memcpy_stubs 4 | -------------------------------------------------------------------------------- /lib/libmemcpy_stubs.clib: -------------------------------------------------------------------------------- 1 | memcpy_stubs.o 2 | -------------------------------------------------------------------------------- /lib/memcpy.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2016 Jeremy Yallop 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Ctypes 18 | 19 | module C = Memcpy_bindings.C(Memcpy_generated) 20 | 21 | type safe = Safe 22 | type unsafe = Unsafe 23 | 24 | type (_, _) spec = 25 | OCaml_bytes : (safe, Bytes.t) spec 26 | | Bigarray : 27 | < ba_repr : 'a; bigarray : 'b; carray : 'c; dims : 'd; element : 'e; 28 | layout: Bigarray.c_layout > bigarray_class * 29 | 'd * 30 | ('e, 'a) Bigarray.kind -> 31 | (safe, 'b) spec 32 | | Pointer : (unsafe, _ ptr) spec 33 | | CArray : (safe, _ carray) spec 34 | 35 | let ocaml_bytes = OCaml_bytes 36 | let bigarray b k s = Bigarray (b, k, s) 37 | let pointer = Pointer 38 | let carray = CArray 39 | 40 | type 'a safespec = (safe, 'a) spec 41 | 42 | 43 | let convert_pointer : 'a. 'a ptr -> int -> unit ptr = 44 | fun ptr offset -> to_voidp ptr +@ offset 45 | 46 | 47 | let rec unsafe_memcpy : type s d s' d'. (s', s) spec -> (d', d) spec -> 48 | src:s -> dst:d -> ?src_off:int -> ?dst_off:int -> len:int -> unit = 49 | fun inspec outspec ~src ~dst ?(src_off=0) ?(dst_off=0) ~len -> 50 | match inspec, outspec with 51 | | _, Bigarray (cls, _, _) -> 52 | unsafe_memcpy inspec Pointer ~src ~dst:(bigarray_start cls dst) ~src_off ~dst_off ~len 53 | | Bigarray (cls, _, _), _ -> 54 | unsafe_memcpy Pointer outspec ~src:(bigarray_start cls src) ~dst ~src_off ~dst_off ~len 55 | | _, CArray -> 56 | unsafe_memcpy inspec Pointer ~src ~dst:(CArray.start dst) ~src_off ~dst_off ~len 57 | | CArray, _ -> 58 | unsafe_memcpy Pointer outspec ~src:(CArray.start src) ~dst ~src_off ~dst_off ~len 59 | | OCaml_bytes, OCaml_bytes -> 60 | ignore (C.memcpy_bytes_bytes (ocaml_bytes_start dst) (ocaml_bytes_start src) 61 | (Unsigned.Size_t.of_int len) dst_off src_off : unit ptr) 62 | | OCaml_bytes, Pointer -> 63 | ignore (C.memcpy_ptr_bytes (to_voidp dst) (ocaml_bytes_start src) 64 | (Unsigned.Size_t.of_int len) dst_off src_off : unit ptr) 65 | | Pointer, OCaml_bytes -> 66 | ignore (C.memcpy_bytes_ptr (ocaml_bytes_start dst) (to_voidp src) 67 | (Unsigned.Size_t.of_int len) dst_off src_off : unit ptr) 68 | | Pointer, Pointer -> 69 | ignore (C.memcpy_ptr_ptr (to_voidp dst) (to_voidp src) 70 | (Unsigned.Size_t.of_int len) dst_off src_off : unit ptr) 71 | 72 | 73 | let length : type a. (safe, a) spec -> a -> int = 74 | fun spec v -> match spec with 75 | OCaml_bytes -> Bytes.length v 76 | | Bigarray (cls, dims, k) -> sizeof (Ctypes.bigarray cls dims k) 77 | | CArray -> CArray.length v * sizeof (CArray.element_type v) 78 | 79 | 80 | let memcpy : type s d. (safe, s) spec -> (safe, d) spec -> 81 | src:s -> dst:d -> ?src_off:int -> ?dst_off:int -> len:int -> unit = 82 | fun inspec outspec ~src ~dst ?(src_off=0) ?(dst_off=0) ~len -> 83 | if len < 0 || src_off < 0 || src_off > length inspec src - len 84 | || dst_off < 0 || dst_off > length outspec dst - len 85 | then invalid_arg "Memcpy.memcpy" 86 | else unsafe_memcpy inspec outspec ~src ~dst ~src_off ~dst_off ~len 87 | 88 | let memcpy_from_string d ~src ?dst_off ~dst = 89 | memcpy OCaml_bytes d ~src:(Bytes.unsafe_of_string src) ?src_off:None 90 | ~dst ?dst_off ~len:(String.length src) 91 | 92 | let memcpy_from_bytes d ~src ?dst_off ~dst = 93 | memcpy OCaml_bytes d ~src ?src_off:None 94 | ~dst ?dst_off ~len:(Bytes.length src) 95 | -------------------------------------------------------------------------------- /lib/memcpy.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2016 Jeremy Yallop 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Efficient copies between various types of memory blocks: bytes, bigarrays, 18 | addresses and arrays *) 19 | 20 | open Ctypes 21 | 22 | (** The types of memory are divided into two classes: [safe], where the bounds 23 | can be checked, and [unsafe], where no bounds information is available. *) 24 | type safe and unsafe 25 | 26 | (** A specification for the type of memory involved in the copy. *) 27 | type ('safe, 'typ) spec 28 | 29 | val ocaml_bytes : (safe, Bytes.t) spec 30 | (** A specification for OCaml's bytes type *) 31 | 32 | val bigarray : 33 | < ba_repr : 'a; bigarray : 'b; carray : 'c; dims : 'd; element : 'e; 34 | layout: Bigarray.c_layout > bigarray_class -> 35 | 'd -> ('e, 'a) Bigarray.kind -> (safe, 'b) spec 36 | (** A specification for a bigarray type *) 37 | 38 | val pointer : (unsafe, _ ptr) spec 39 | (** A specification for a Ctypes pointer type *) 40 | 41 | val carray : (safe, _ carray) spec 42 | (** A specification for a Ctypes array type *) 43 | 44 | val memcpy : (safe, 's) spec -> (safe, 'd) spec -> src:'s -> dst:'d -> ?src_off:int -> ?dst_off:int -> len:int -> unit 45 | (** [memcpy s d ~src ~dst ~src_off ~dst_off ~len] copies [len] bytes from 46 | offset [src_off] of [src] to offset [dst_off] of [dst]. 47 | 48 | @raise [Invalid_argument "Memcpy.memcpy"] if the memory between [src_off] 49 | and [src_off + len] does not fall within [src] or if the memory between 50 | [dst_off] and [dst_off + len] does not fall within [dst]. *) 51 | 52 | val unsafe_memcpy : (_, 's) spec -> (_, 'd) spec -> src:'s -> dst:'d -> ?src_off:int -> ?dst_off:int -> len:int -> unit 53 | (** [unsafe_memcpy s d ~src ~dst ~src_off ~dst_off ~len] copies [len] bytes from 54 | offset [src_off] of [src] to offset [dst_off] of [dst]. 55 | 56 | No attempt is made to check that the specified regions of memory actually 57 | fall within [src] and [dst]. *) 58 | 59 | val memcpy_from_string : (safe, 'd) spec -> src:string -> ?dst_off:int -> dst:'d -> unit 60 | (** [memcpy_from_string d ~src ~dst ~dst_off] copies [src] to offset [dst_off] of [dst]. 61 | 62 | @raise [Invalid_argument "Memcpy.memcpy"] if the memory between 63 | [dst_off] and [dst_off + len] does not fall within [dst]. *) 64 | 65 | val memcpy_from_bytes : (safe, 'd) spec -> src:Bytes.t -> ?dst_off:int -> dst:'d -> unit 66 | (** [memcpy_from_bytes d ~src ~dst ~dst_off] copies [src] to offset [dst_off] of [dst]. 67 | 68 | @raise [Invalid_argument "Memcpy.memcpy"] if the memory between 69 | [dst_off] and [dst_off + len] does not fall within [dst]. *) 70 | -------------------------------------------------------------------------------- /lib_gen/_tags: -------------------------------------------------------------------------------- 1 | true: package(ctypes.stubs) 2 | -------------------------------------------------------------------------------- /lib_gen/memcpy_bindgen.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2016 Jeremy Yallop 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Ctypes 18 | 19 | let prologue = " 20 | #include 21 | 22 | static void *memcpy_with_offsets 23 | (char *dst, const char *src, size_t len, int dst_off, int src_off) 24 | { 25 | return memcpy(dst + dst_off, src + src_off, len); 26 | } 27 | " 28 | 29 | let () = 30 | let prefix = "memcpy_" in 31 | let stubs_oc = open_out "lib/memcpy_stubs.c" in 32 | let fmt = Format.formatter_of_out_channel stubs_oc in 33 | Format.fprintf fmt "%s@." prologue; 34 | Cstubs.write_c fmt ~prefix (module Memcpy_bindings.C); 35 | close_out stubs_oc; 36 | 37 | let generated_oc = open_out "lib/memcpy_generated.ml" in 38 | let fmt = Format.formatter_of_out_channel generated_oc in 39 | Cstubs.write_ml fmt ~prefix (module Memcpy_bindings.C); 40 | close_out generated_oc 41 | -------------------------------------------------------------------------------- /lib_gen/memcpy_bindings.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2016 Jeremy Yallop 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Ctypes 18 | 19 | module C(F: Cstubs.FOREIGN) = struct 20 | open F 21 | 22 | let memcpy dst src = 23 | foreign "memcpy_with_offsets" 24 | (dst @-> src @-> size_t @-> int @-> int @-> returning (ptr void)) 25 | 26 | let s = ocaml_bytes and p = ptr void 27 | let memcpy_bytes_bytes = memcpy s s 28 | let memcpy_bytes_ptr = memcpy s p 29 | let memcpy_ptr_bytes = memcpy p s 30 | let memcpy_ptr_ptr = memcpy p p 31 | end 32 | -------------------------------------------------------------------------------- /lib_test/_tags: -------------------------------------------------------------------------------- 1 | <*.*>: package(oUnit), package(ctypes.stubs), use_memcpy_stubs 2 | -------------------------------------------------------------------------------- /lib_test/test.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2016 Jeremy Yallop. 3 | * 4 | * This file is distributed under the terms of the MIT License. 5 | * See the file LICENSE for details. 6 | *) 7 | 8 | open OUnit2 9 | open Bigarray 10 | 11 | 12 | module type BUF = 13 | sig 14 | type t 15 | type safe 16 | val name : string 17 | val t : int -> (safe, t) Memcpy.spec 18 | val to_string : t -> string 19 | val of_string : string -> t 20 | end 21 | 22 | module Bytes_buf : 23 | BUF with type t = Bytes.t 24 | and type safe = Memcpy.safe = 25 | struct 26 | include Bytes 27 | type safe = Memcpy.safe 28 | let t _ = Memcpy.ocaml_bytes 29 | let name = "bytes" 30 | end 31 | 32 | module Bigarray_buf : 33 | BUF with type t = (char, int8_unsigned_elt, c_layout) Array1.t 34 | and type safe = Memcpy.safe = 35 | struct 36 | type t = (char, int8_unsigned_elt, c_layout) Array1.t 37 | type safe = Memcpy.safe 38 | let t sz = Memcpy.bigarray Ctypes.array1 sz Bigarray.char 39 | 40 | let to_string a = 41 | let len = Array1.dim a in 42 | let buf = Bytes.make len '\000' in 43 | begin 44 | for i = 0 to len - 1 do 45 | Bytes.set buf i (Array1.get a i) 46 | done; 47 | Bytes_buf.to_string buf 48 | end 49 | 50 | let of_string s = 51 | let arr = Array1.create char c_layout (String.length s) in 52 | let () = String.iteri (Array1.set arr) s in 53 | arr 54 | 55 | let name = "bigarray" 56 | end 57 | 58 | module CArray_buf : 59 | BUF with type t = char Ctypes.carray 60 | and type safe = Memcpy.safe = 61 | struct 62 | type t = char Ctypes.carray 63 | type safe = Memcpy.safe 64 | let t sz = Memcpy.carray 65 | 66 | let to_string a = 67 | let len = Ctypes.CArray.length a in 68 | let buf = Bytes.make len '\000' in 69 | begin 70 | for i = 0 to len - 1 do 71 | Bytes.set buf i (Ctypes.CArray.get a i) 72 | done; 73 | Bytes_buf.to_string buf 74 | end 75 | 76 | let of_string s = 77 | let arr = Ctypes.(CArray.make char) (String.length s) in 78 | let () = String.iteri (Ctypes.CArray.set arr) s in 79 | arr 80 | 81 | let name = "carray" 82 | end 83 | 84 | 85 | module type TESTS = sig val tests : test end 86 | 87 | 88 | module Safe_tests 89 | (In: BUF with type safe = Memcpy.safe) 90 | (Out: BUF with type safe = Memcpy.safe) : TESTS = 91 | struct 92 | let check_bounds_failure ?src_off ?dst_off ?len ~from ~into () = 93 | let dstlen = String.length into 94 | and srclen = String.length from 95 | and dst = Out.of_string into 96 | and src = In.of_string from in 97 | let len = match len with None -> srclen | Some len -> len in 98 | assert_raises (Invalid_argument "Memcpy.memcpy") 99 | (fun () -> 100 | Memcpy.memcpy (In.t srclen) (Out.t dstlen) 101 | ~src ~dst ?src_off ?dst_off ~len) 102 | 103 | let check_copying ?src_off ?dst_off ?len ~from ~into ~produces () = 104 | let dstlen = String.length into 105 | and srclen = String.length from 106 | and dst = Out.of_string into 107 | and src = In.of_string from in 108 | let len = match len with None -> srclen | Some len -> len in 109 | let () = Memcpy.memcpy (In.t srclen) (Out.t dstlen) 110 | ~src ~dst ?src_off ?dst_off ~len 111 | in 112 | assert_equal produces (Out.to_string dst) 113 | ~printer:(fun x -> x) 114 | 115 | let check_copying_bytes ?dst_off ~from ~into ~produces () = 116 | let dstlen = String.length into 117 | and dst = Out.of_string into 118 | and src = Bytes.of_string from in 119 | let () = Memcpy.memcpy_from_bytes (Out.t dstlen) 120 | ~src ~dst ?dst_off 121 | in 122 | assert_equal produces (Out.to_string dst) 123 | ~printer:(fun x -> x) 124 | 125 | let check_copying_string ?dst_off ~from ~into ~produces () = 126 | let dstlen = String.length into 127 | and dst = Out.of_string into 128 | and src = from in 129 | let () = Memcpy.memcpy_from_string (Out.t dstlen) 130 | ~src ~dst ?dst_off 131 | in 132 | assert_equal produces (Out.to_string dst) 133 | ~printer:(fun x -> x) 134 | 135 | let test_full_overlap _ = 136 | check_copying 137 | ~from: "abcdefghijkl" 138 | ~into: "0123456789AB" 139 | ~produces:"abcdefghijkl" 140 | () 141 | 142 | let test_full_overlap_bytes _ = 143 | check_copying_bytes 144 | ~from: "abcdefghijkl" 145 | ~into: "0123456789AB" 146 | ~produces:"abcdefghijkl" 147 | () 148 | 149 | let test_full_overlap_string _ = 150 | check_copying_string 151 | ~from: "abcdefghijkl" 152 | ~into: "0123456789AB" 153 | ~produces:"abcdefghijkl" 154 | () 155 | 156 | let test_short_src _ = 157 | check_copying 158 | ~from: "abc" 159 | ~into: "0123456789AB" 160 | ~produces:"abc3456789AB" 161 | () 162 | 163 | let test_short_src_with_dst_offset _ = 164 | check_copying 165 | ~dst_off:3 166 | ~from: "abc" 167 | ~into: "0123456789AB" 168 | ~produces:"012abc6789AB" 169 | () 170 | 171 | let test_short_src_with_dst_offset_bytes _ = 172 | check_copying_bytes 173 | ~dst_off:3 174 | ~from: "abc" 175 | ~into: "0123456789AB" 176 | ~produces:"012abc6789AB" 177 | () 178 | 179 | let test_short_src_with_dst_offset_string _ = 180 | check_copying_string 181 | ~dst_off:3 182 | ~from: "abc" 183 | ~into: "0123456789AB" 184 | ~produces:"012abc6789AB" 185 | () 186 | 187 | let test_with_src_offset_and_len _ = 188 | check_copying 189 | ~src_off:5 190 | ~len:3 191 | ~from: "abcdefghijkl" 192 | ~into: "0123456789AB" 193 | ~produces:"fgh3456789AB" 194 | () 195 | 196 | let test_with_src_offset_and_dst_offset_and_len _ = 197 | check_copying 198 | ~src_off:5 199 | ~dst_off:1 200 | ~len:3 201 | ~from: "abcdefghijkl" 202 | ~into: "0123456789AB" 203 | ~produces:"0fgh456789AB" 204 | () 205 | 206 | let test_bounds_failure_src_offset_below_zero _ = 207 | check_bounds_failure 208 | ~src_off:(-1) 209 | ~len:1 210 | ~from: "abc" 211 | ~into: "def" 212 | () 213 | 214 | let test_bounds_failure_len_below_zero _ = 215 | check_bounds_failure 216 | ~len:(-1) 217 | ~from: "abc" 218 | ~into: "def" 219 | () 220 | 221 | let test_bounds_failure_dst_offset_below_zero _ = 222 | check_bounds_failure 223 | ~dst_off:(-1) 224 | ~from: "abc" 225 | ~into: "def" 226 | () 227 | 228 | let test_bounds_failure_length_exceeds_src_length _ = 229 | check_bounds_failure 230 | ~len:4 231 | ~from: "abc" 232 | ~into: "def" 233 | () 234 | 235 | let test_bounds_failure_length_exceeds_dst_length _ = 236 | check_bounds_failure 237 | ~len:4 238 | ~from: "abcd" 239 | ~into: "def" 240 | () 241 | 242 | let test_bounds_failure_offset_plus_length_exceeds_src_length _ = 243 | check_bounds_failure 244 | ~src_off:2 245 | ~len:2 246 | ~from: "abc" 247 | ~into: "def" 248 | () 249 | 250 | let test_bounds_failure_offset_plus_length_exceeds_dst_length _ = 251 | check_bounds_failure 252 | ~len:2 253 | ~dst_off:2 254 | ~from: "abcd" 255 | ~into: "def" 256 | () 257 | 258 | let tests = 259 | Printf.sprintf "safe tests (from %s to %s)" 260 | In.name Out.name >::: [ 261 | "full overlap" >:: 262 | test_full_overlap; 263 | 264 | "full overlap (bytes)" >:: 265 | test_full_overlap_bytes; 266 | 267 | "full overlap (string)" >:: 268 | test_full_overlap_string; 269 | 270 | "short source" >:: 271 | test_short_src; 272 | 273 | "short source with dst offset" >:: 274 | test_short_src_with_dst_offset; 275 | 276 | "short source with dst offset (bytes)" >:: 277 | test_short_src_with_dst_offset_bytes; 278 | 279 | "short source with dst offset (string)" >:: 280 | test_short_src_with_dst_offset_string; 281 | 282 | "short source with src offset and length" >:: 283 | test_with_src_offset_and_len; 284 | 285 | "short source with src offset and dst offset and length" >:: 286 | test_with_src_offset_and_dst_offset_and_len; 287 | 288 | "test failure when src_off is_below_zero" >:: 289 | test_bounds_failure_src_offset_below_zero; 290 | 291 | "test failure when length is_below_zero" >:: 292 | test_bounds_failure_len_below_zero; 293 | 294 | "test failure when dst_off is_below_zero" >:: 295 | test_bounds_failure_dst_offset_below_zero; 296 | 297 | "test failure when length exceeds src length" >:: 298 | test_bounds_failure_length_exceeds_src_length; 299 | 300 | "test failure when length exceeds dst length" >:: 301 | test_bounds_failure_length_exceeds_dst_length; 302 | 303 | "test failure when offset+length exceeds src length" >:: 304 | test_bounds_failure_offset_plus_length_exceeds_src_length; 305 | 306 | "test failure when offset+length exceeds dst length" >:: 307 | test_bounds_failure_offset_plus_length_exceeds_dst_length; 308 | ] 309 | end 310 | 311 | 312 | let suite = 313 | "Memcpy tests" >::: 314 | List.map (fun (module T: TESTS) -> T.tests) 315 | ([(module Safe_tests(Bytes_buf) (Bytes_buf)); 316 | (module Safe_tests(Bytes_buf) (Bigarray_buf)); 317 | (module Safe_tests(Bytes_buf) (CArray_buf)); 318 | (module Safe_tests(Bigarray_buf) (Bytes_buf)); 319 | (module Safe_tests(Bigarray_buf) (Bigarray_buf)); 320 | (module Safe_tests(Bigarray_buf) (CArray_buf)); 321 | (module Safe_tests(CArray_buf) (Bytes_buf)); 322 | (module Safe_tests(CArray_buf) (Bigarray_buf)); 323 | (module Safe_tests(CArray_buf) (CArray_buf)); 324 | ] : (module TESTS) list) 325 | 326 | 327 | 328 | let _ = 329 | run_test_tt_main suite 330 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | open Ocamlbuild_plugin;; 2 | open Ocamlbuild_pack;; 3 | 4 | let ctypes_libdir = Sys.getenv "CTYPES_LIB_DIR" in 5 | 6 | dispatch begin 7 | function 8 | | After_rules -> 9 | 10 | rule "cstubs: lib/x_bindings.ml -> x_stubs.c, x_generated.ml" 11 | ~prods:["lib/%_stubs.c"; "lib/%_generated.ml"] 12 | ~deps: ["lib_gen/%_bindgen.byte"] 13 | (fun env build -> 14 | Cmd (A(env "lib_gen/%_bindgen.byte"))); 15 | 16 | copy_rule "cstubs: lib_gen/x_bindings.ml -> lib/x_bindings.ml" 17 | "lib_gen/%_bindings.ml" "lib/%_bindings.ml"; 18 | 19 | (* Linking cstubs *) 20 | flag ["c"; "compile"; "use_ctypes"] & S[A"-I"; A ctypes_libdir]; 21 | flag ["c"; "compile"; "debug"] & A"-g"; 22 | 23 | (* Linking generated stubs *) 24 | flag ["ocaml"; "link"; "byte"; "library"; "use_memcpy_stubs"] & 25 | S[A"-dllib"; A"-lmemcpy_stubs"]; 26 | flag ["ocaml"; "link"; "native"; "library"; "use_memcpy_stubs"] & 27 | S[A"-cclib"; A"-lmemcpy_stubs"]; 28 | 29 | (* Linking tests *) 30 | flag ["ocaml"; "link"; "byte"; "program"; "use_memcpy_stubs"] & 31 | S[A"-dllib"; A"-lmemcpy_stubs"; A"-I"; A"lib/"]; 32 | dep ["ocaml"; "link"; "native"; "program"; "use_memcpy_stubs"] 33 | ["lib/libmemcpy_stubs"-.-(!Options.ext_lib)]; 34 | | _ -> () 35 | end;; 36 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | name: "memcpy" 3 | version: "dev" 4 | maintainer: "yallop@gmail.com" 5 | author: "yallop@gmail.com" 6 | homepage: "https://github.com/yallop/ocaml-memcpy" 7 | dev-repo: "http://github.com/yallop/ocaml-memcpy.git" 8 | bug-reports: "http://github.com/yallop/ocaml-memcpy/issues" 9 | license: "MIT" 10 | build: [[make]] 11 | install: [[make "install"]] 12 | build-test: [[make "test"]] 13 | remove: [["ocamlfind" "remove" "memcpy"]] 14 | depends: [ 15 | "ctypes" {>= "0.12.0"} 16 | "ounit" {test} 17 | "ocamlfind" {build} 18 | "ocamlbuild" {build} 19 | ] 20 | available: [ ocaml-version >= "4.01.0" ] 21 | --------------------------------------------------------------------------------