Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add Unsafe operations #317

Open
wants to merge 3 commits into
base: main
Choose a base branch
from
Open

Add Unsafe operations #317

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
7dc05e8
Add Unsafe base operations
smuenzel Nov 16, 2024
9581112
More unsafe ops
smuenzel Nov 16, 2024
9ea4162
ocaml-migrate-parsetree is not required
smuenzel Nov 16, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
155 changes: 108 additions & 47 deletions lib/cstruct.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -268,23 +268,42 @@ let create len =
let t = create_unsafe len in
memset t 0;
t
module type GetterSetterByte = sig
val get_char: t -> int -> char
val get_uint8: t -> int -> uint8
val set_char: t -> int -> char -> unit
val set_uint8: t -> int -> uint8 -> unit
end

module Unsafe = struct
let set_uint8 t i c =
Bigarray.Array1.unsafe_set t.buffer (t.off+i) (Char.unsafe_chr c)

let set_char t i c =
Bigarray.Array1.unsafe_set t.buffer (t.off+i) c

let get_uint8 t i =
Char.code (Bigarray.Array1.unsafe_get t.buffer (t.off+i))

let get_char t i =
Bigarray.Array1.unsafe_get t.buffer (t.off+i)
end

let set_uint8 t i c =
if i >= t.len || i < 0 then err_invalid_bounds "set_uint8" t i 1
else Bigarray.Array1.set t.buffer (t.off+i) (Char.unsafe_chr c)
else Unsafe.set_uint8 t i c

let set_char t i c =
if i >= t.len || i < 0 then err_invalid_bounds "set_char" t i 1
else Bigarray.Array1.set t.buffer (t.off+i) c
else Unsafe.set_char t i c

let get_uint8 t i =
if i >= t.len || i < 0 then err_invalid_bounds "get_uint8" t i 1
else Char.code (Bigarray.Array1.get t.buffer (t.off+i))
else Unsafe.get_uint8 t i

let get_char t i =
if i >= t.len || i < 0 then err_invalid_bounds "get_char" t i 1
else Bigarray.Array1.get t.buffer (t.off+i)

else Unsafe.get_char t i

external ba_set_int16 : buffer -> int -> uint16 -> unit = "%caml_bigstring_set16u"
external ba_set_int32 : buffer -> int -> uint32 -> unit = "%caml_bigstring_set32u"
Expand All @@ -297,61 +316,103 @@ external swap16 : int -> int = "%bswap16"
external swap32 : int32 -> int32 = "%bswap_int32"
external swap64 : int64 -> int64 = "%bswap_int64"

let set_uint16 swap p t i c =
if i > t.len - 2 || i < 0 then err_invalid_bounds (p ^ ".set_uint16") t i 2
else ba_set_int16 t.buffer (t.off+i) (if swap then swap16 c else c) [@@inline]
module type Swap = sig
val swap : bool
val name : string
end

let set_uint32 swap p t i c =
if i > t.len - 4 || i < 0 then err_invalid_bounds (p ^ ".set_uint32") t i 4
else ba_set_int32 t.buffer (t.off+i) (if swap then swap32 c else c) [@@inline]
module type GetterSetterMultiByte = sig
val get_uint16: t -> int -> uint16
val get_uint32: t -> int -> uint32
val get_uint64: t -> int -> uint64
val set_uint16: t -> int -> uint16 -> unit
val set_uint32: t -> int -> uint32 -> unit
val set_uint64: t -> int -> uint64 -> unit
end

let set_uint64 swap p t i c =
if i > t.len - 8 || i < 0 then err_invalid_bounds (p ^ ".set_uint64") t i 8
else ba_set_int64 t.buffer (t.off+i) (if swap then swap64 c else c) [@@inline]
module type GetterSetterMultiByteWithSwap = sig
module Swap : Swap
include GetterSetterMultiByte
end

let get_uint16 swap p t i =
if i > t.len - 2 || i < 0 then err_invalid_bounds (p ^ ".get_uint16") t i 2
else
let r = ba_get_int16 t.buffer (t.off+i) in
if swap then swap16 r else r [@@inline]
module Internal = struct
module Unsafe(Swap : Swap) = struct
module Swap = Swap

let get_uint32 swap p t i =
if i > t.len - 4 || i < 0 then err_invalid_bounds (p ^ ".get_uint32") t i 4
else
let r = ba_get_int32 t.buffer (t.off+i) in
if swap then swap32 r else r [@@inline]
let set_uint16 t i c =
ba_set_int16 t.buffer (t.off+i) (if Swap.swap then swap16 c else c) [@@inline]

let get_uint64 swap p t i =
if i > t.len - 8 || i < 0 then err_invalid_bounds (p ^ ".get_uint64") t i 8
else
let r = ba_get_int64 t.buffer (t.off+i) in
if swap then swap64 r else r [@@inline]
let set_uint32 t i c =
ba_set_int32 t.buffer (t.off+i) (if Swap.swap then swap32 c else c) [@@inline]

let set_uint64 t i c =
ba_set_int64 t.buffer (t.off+i) (if Swap.swap then swap64 c else c) [@@inline]

let get_uint16 t i =
let r = ba_get_int16 t.buffer (t.off+i) in
if Swap.swap then swap16 r else r [@@inline]

let get_uint32 t i =
let r = ba_get_int32 t.buffer (t.off+i) in
if Swap.swap then swap32 r else r [@@inline]

let get_uint64 t i =
let r = ba_get_int64 t.buffer (t.off+i) in
if Swap.swap then swap64 r else r [@@inline]
end [@@inline]

module Safe(Unsafe : GetterSetterMultiByteWithSwap) = struct
module Unsafe = Unsafe
module Swap = Unsafe.Swap

let set_uint16 t i c =
if i > t.len - 2 || i < 0 then err_invalid_bounds (Swap.name ^ ".set_uint16") t i 2
else Unsafe.set_uint16 t i c [@@inline]

let set_uint32 t i c =
if i > t.len - 4 || i < 0 then err_invalid_bounds (Swap.name ^ ".set_uint32") t i 4
else Unsafe.set_uint32 t i c [@@inline]

let set_uint64 t i c =
if i > t.len - 8 || i < 0 then err_invalid_bounds (Swap.name ^ ".set_uint64") t i 8
else Unsafe.set_uint64 t i c [@@inline]

let get_uint16 t i =
if i > t.len - 2 || i < 0 then err_invalid_bounds (Swap.name ^ ".get_uint16") t i 2
else Unsafe.get_uint16 t i [@@inline]

let get_uint32 t i =
if i > t.len - 4 || i < 0 then err_invalid_bounds (Swap.name ^ ".get_uint32") t i 4
else Unsafe.get_uint32 t i [@@inline]

let get_uint64 t i =
if i > t.len - 8 || i < 0 then err_invalid_bounds (Swap.name ^ ".get_uint64") t i 8
else Unsafe.get_uint64 t i [@@inline]
end [@@inline]
end

module BE = struct
let set_uint16 t i c = set_uint16 (not Sys.big_endian) "BE" t i c [@@inline]
let set_uint32 t i c = set_uint32 (not Sys.big_endian) "BE" t i c [@@inline]
let set_uint64 t i c = set_uint64 (not Sys.big_endian) "BE" t i c [@@inline]
let get_uint16 t i = get_uint16 (not Sys.big_endian) "BE" t i [@@inline]
let get_uint32 t i = get_uint32 (not Sys.big_endian) "BE" t i [@@inline]
let get_uint64 t i = get_uint64 (not Sys.big_endian) "BE" t i [@@inline]
open Internal
include Safe(Unsafe(struct
let swap = not Sys.big_endian
let name = "BE"
end))
end

module LE = struct
let set_uint16 t i c = set_uint16 Sys.big_endian "LE" t i c [@@inline]
let set_uint32 t i c = set_uint32 Sys.big_endian "LE" t i c [@@inline]
let set_uint64 t i c = set_uint64 Sys.big_endian "LE" t i c [@@inline]
let get_uint16 t i = get_uint16 Sys.big_endian "LE" t i [@@inline]
let get_uint32 t i = get_uint32 Sys.big_endian "LE" t i [@@inline]
let get_uint64 t i = get_uint64 Sys.big_endian "LE" t i [@@inline]
open Internal
include Safe(Unsafe(struct
let swap = Sys.big_endian
let name = "LE"
end))
end

module HE = struct
let set_uint16 t i c = set_uint16 false "HE" t i c [@@inline]
let set_uint32 t i c = set_uint32 false "HE" t i c [@@inline]
let set_uint64 t i c = set_uint64 false "HE" t i c [@@inline]
let get_uint16 t i = get_uint16 false "HE" t i [@@inline]
let get_uint32 t i = get_uint32 false "HE" t i [@@inline]
let get_uint64 t i = get_uint64 false "HE" t i [@@inline]
open Internal
include Safe(Unsafe(struct
let swap = false
let name = "HE"
end))
end

let length { len ; _ } = len
Expand Down
128 changes: 43 additions & 85 deletions lib/cstruct.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -258,25 +258,30 @@ val check_alignment : t -> int -> bool
boundary.
@raise Invalid_argument if [alignment] is not a positive integer. *)

val get_char: t -> int -> char
(** [get_char t off] returns the character contained in the cstruct
at offset [off].
@raise Invalid_argument if the offset exceeds cstruct length. *)

val get_uint8: t -> int -> uint8
(** [get_uint8 t off] returns the byte contained in the cstruct
at offset [off].
@raise Invalid_argument if the offset exceeds cstruct length. *)

val set_char: t -> int -> char -> unit
(** [set_char t off c] sets the byte contained in the cstruct
at offset [off] to character [c].
@raise Invalid_argument if the offset exceeds cstruct length. *)
module type GetterSetterByte = sig
val get_char: t -> int -> char
(** [get_char t off] returns the character contained in the cstruct
at offset [off].
@raise Invalid_argument if the offset exceeds cstruct length. *)

val get_uint8: t -> int -> uint8
(** [get_uint8 t off] returns the byte contained in the cstruct
at offset [off].
@raise Invalid_argument if the offset exceeds cstruct length. *)

val set_char: t -> int -> char -> unit
(** [set_char t off c] sets the byte contained in the cstruct
at offset [off] to character [c].
@raise Invalid_argument if the offset exceeds cstruct length. *)

val set_uint8: t -> int -> uint8 -> unit
(** [set_uint8 t off c] sets the byte contained in the cstruct
at offset [off] to byte [c].
@raise Invalid_argument if the offset exceeds cstruct length. *)
end
include GetterSetterByte

val set_uint8: t -> int -> uint8 -> unit
(** [set_uint8 t off c] sets the byte contained in the cstruct
at offset [off] to byte [c].
@raise Invalid_argument if the offset exceeds cstruct length. *)
module Unsafe : GetterSetterByte

val sub: t -> int -> int -> t
(** [sub cstr off len] is [{ t with off = t.off + off; len }]
Expand Down Expand Up @@ -372,78 +377,57 @@ val to_bytes: ?off:int -> ?len:int -> t -> bytes
@raise Invalid_argument if [off] or [len] is negative, or
[Cstruct.length str - off] < [len]. *)

module BE : sig

(** Get/set big-endian integers of various sizes. The second
argument of those functions is the position relative to the
current offset of the cstruct. *)

module type GetterSetterMultiByte = sig
val get_uint16: t -> int -> uint16
(** [get_uint16 cstr off] is the 16 bit long big-endian unsigned
(** [get_uint16 cstr off] is the 16 bit long unsigned
integer stored in [cstr] at offset [off].
@raise Invalid_argument if the buffer is too small. *)

val get_uint32: t -> int -> uint32
(** [get_uint32 cstr off] is the 32 bit long big-endian unsigned
(** [get_uint32 cstr off] is the 32 bit long unsigned
integer stored in [cstr] at offset [off].
@raise Invalid_argument if the buffer is too small. *)

val get_uint64: t -> int -> uint64
(** [get_uint64 cstr off] is the 64 bit long big-endian unsigned
(** [get_uint64 cstr off] is the 64 bit long unsigned
integer stored in [cstr] at offset [off].
@raise Invalid_argument if the buffer is too small. *)

val set_uint16: t -> int -> uint16 -> unit
(** [set_uint16 cstr off i] writes the 16 bit long big-endian
(** [set_uint16 cstr off i] writes the 16 bit long
unsigned integer [i] at offset [off] of [cstr].
@raise Invalid_argument if the buffer is too small. *)

val set_uint32: t -> int -> uint32 -> unit
(** [set_uint32 cstr off i] writes the 32 bit long big-endian
(** [set_uint32 cstr off i] writes the 32 bit long
unsigned integer [i] at offset [off] of [cstr].
@raise Invalid_argument if the buffer is too small. *)

val set_uint64: t -> int -> uint64 -> unit
(** [set_uint64 cstr off i] writes the 64 bit long big-endian
(** [set_uint64 cstr off i] writes the 64 bit long
unsigned integer [i] at offset [off] of [cstr].
@raise Invalid_argument if the buffer is too small. *)
end

module LE : sig
module BE : sig

(** Get/set little-endian integers of various sizes. The second
(** Get/set big-endian integers of various sizes. The second
argument of those functions is the position relative to the
current offset of the cstruct. *)
include GetterSetterMultiByte

val get_uint16: t -> int -> uint16
(** [get_uint16 cstr off] is the 16 bit long little-endian unsigned
integer stored in [cstr] at offset [off].
@raise Invalid_argument if the buffer is too small. *)

val get_uint32: t -> int -> uint32
(** [get_uint32 cstr off] is the 32 bit long little-endian unsigned
integer stored in [cstr] at offset [off].
@raise Invalid_argument if the buffer is too small. *)
module Unsafe : GetterSetterMultiByte
end

val get_uint64: t -> int -> uint64
(** [get_uint64 cstr off] is the 64 bit long little-endian unsigned
integer stored in [cstr] at offset [off].
@raise Invalid_argument if the buffer is too small. *)
module LE : sig

val set_uint16: t -> int -> uint16 -> unit
(** [set_uint16 cstr off i] writes the 16 bit long little-endian
unsigned integer [i] at offset [off] of [cstr].
@raise Invalid_argument if the buffer is too small. *)
(** Get/set little-endian integers of various sizes. The second
argument of those functions is the position relative to the
current offset of the cstruct. *)

val set_uint32: t -> int -> uint32 -> unit
(** [set_uint32 cstr off i] writes the 32 bit long little-endian
unsigned integer [i] at offset [off] of [cstr].
@raise Invalid_argument if the buffer is too small. *)
include GetterSetterMultiByte

val set_uint64: t -> int -> uint64 -> unit
(** [set_uint64 cstr off i] writes the 64 bit long little-endian
unsigned integer [i] at offset [off] of [cstr].
@raise Invalid_argument if the buffer is too small. *)
module Unsafe : GetterSetterMultiByte
end

module HE : sig
Expand All @@ -452,35 +436,9 @@ module HE : sig
argument of those functions is the position relative to the
current offset of the cstruct. *)

val get_uint16: t -> int -> uint16
(** [get_uint16 cstr off] is the 16 bit long host-endian unsigned
integer stored in [cstr] at offset [off].
@raise Invalid_argument if the buffer is too small. *)

val get_uint32: t -> int -> uint32
(** [get_uint32 cstr off] is the 32 bit long host-endian unsigned
integer stored in [cstr] at offset [off].
@raise Invalid_argument if the buffer is too small. *)
include GetterSetterMultiByte

val get_uint64: t -> int -> uint64
(** [get_uint64 cstr off] is the 64 bit long host-endian unsigned
integer stored in [cstr] at offset [off].
@raise Invalid_argument if the buffer is too small. *)

val set_uint16: t -> int -> uint16 -> unit
(** [set_uint16 cstr off i] writes the 16 bit long host-endian
unsigned integer [i] at offset [off] of [cstr].
@raise Invalid_argument if the buffer is too small. *)

val set_uint32: t -> int -> uint32 -> unit
(** [set_uint32 cstr off i] writes the 32 bit long host-endian
unsigned integer [i] at offset [off] of [cstr].
@raise Invalid_argument if the buffer is too small. *)

val set_uint64: t -> int -> uint64 -> unit
(** [set_uint64 cstr off i] writes the 64 bit long host-endian
unsigned integer [i] at offset [off] of [cstr].
@raise Invalid_argument if the buffer is too small. *)
module Unsafe : GetterSetterMultiByte
end

(** {2 Debugging } *)
Expand Down
Loading
Loading