(* $Id: netnumber.mlp 1701 2012-02-14 14:48:46Z gerd $ *)
(* NOTE: Parts of this implementation depend very much of representation
* details of O'Caml 3.xx. It is not guaranteed that this works in future
* versions of O'Caml as well.
*)
(* representation types *)
IFDEF WORDSIZE_64 THEN
type int4 = int (* faster on 64 bit platforms! *)
type uint4 = int
(* Note that values >= 0x8000_0000 are represented as negative ints, i.e.
the bits 32-62 are all set to 1.
*)
ELSE
type int4 = int32
type uint4 = int32
END
type int8 = int64
type uint8 = int64
type fp4 = int32 (* string;; *) (* IEEE representation of fp numbers *)
type fp8 = int64
exception Cannot_represent of string
(* raised if numbers are too big to map them to other type *)
exception Out_of_range
module type ENCDEC = sig
val read_int4 : string -> int -> int4
val read_int8 : string -> int -> int8
val read_uint4 : string -> int -> uint4
val read_uint8 : string -> int -> uint8
val read_int4_unsafe : string -> int -> int4
val read_int8_unsafe : string -> int -> int8
val read_uint4_unsafe : string -> int -> uint4
val read_uint8_unsafe : string -> int -> uint8
val write_int4 : string -> int -> int4 -> unit
val write_int8 : string -> int -> int8 -> unit
val write_uint4 : string -> int -> uint4 -> unit
val write_uint8 : string -> int -> uint8 -> unit
val write_int4_unsafe : string -> int -> int4 -> unit
val write_int8_unsafe : string -> int -> int8 -> unit
val write_uint4_unsafe : string -> int -> uint4 -> unit
val write_uint8_unsafe : string -> int -> uint8 -> unit
val int4_as_string : int4 -> string
val int8_as_string : int8 -> string
val uint4_as_string : uint4 -> string
val uint8_as_string : uint8 -> string
val write_fp4 : string -> int -> fp4 -> unit
val write_fp8 : string -> int -> fp8 -> unit
val fp4_as_string : fp4 -> string
val fp8_as_string : fp8 -> string
val read_fp4 : string -> int -> fp4
val read_fp8 : string -> int -> fp8
end
let rec cannot_represent s =
(* "rec" because this prevents this function from being inlined *)
raise (Cannot_represent s)
(**********************************************************************)
(* cmp *)
(**********************************************************************)
IFDEF WORDSIZE_64 THEN
let lt_uint4 x y =
if x < y then x >= 0 else y < x && y < 0
ELSE
let lt_uint4 x y =
if x < y then
x >= 0l
(* because:
- if x < 0 && y < 0 ==> x >u y
- if x < 0 && y >= 0 ==> x >u y
- if x >= 0 && y => 0 ==> x <u y
*)
else (* ==> y <= x *)
y < x && y < 0l
(* because:
- if y < 0 && x < 0 ==> x <u y
- if y < 0 && x >= 0 ==> x <u y
- if y >= 0 && x >= 0 ==> x >u y
*)
END
let le_uint4 x y = not(lt_uint4 y x)
let gt_uint4 x y = lt_uint4 y x
let ge_uint4 x y = not(lt_uint4 x y)
let lt_uint8 x y =
if x < y then x >= 0L else y < x && y < 0L
let le_uint8 x y = not(lt_uint8 y x)
let gt_uint8 x y = lt_uint8 y x
let ge_uint8 x y = not(lt_uint8 x y)
(**********************************************************************)
(* mk_[u]intn *)
(**********************************************************************)
(* compatibility interface *)
IFDEF WORDSIZE_64 THEN
let mk_int4 (c3,c2,c1,c0) =
let n3 = (Char.code c3) in
let n2 = (Char.code c2) in
let n1 = (Char.code c1) in
let n0 = (Char.code c0) in
(* be careful to set the sign correctly: *)
((n3 lsl 55) asr 31) lor (n2 lsl 16) lor (n1 lsl 8) lor n0
ELSE
let mk_int4 (c3,c2,c1,c0) =
let n3 = Int32.of_int (Char.code c3) in
let n2 = Int32.of_int (Char.code c2) in
let n1 = Int32.of_int (Char.code c1) in
let n0 = Int32.of_int (Char.code c0) in
Int32.logor
(Int32.shift_left n3 24)
(Int32.logor
(Int32.shift_left n2 16)
(Int32.logor
(Int32.shift_left n1 8)
n0))
END
let mk_int8 (c7,c6,c5,c4,c3,c2,c1,c0) =
let n7 = Int64.of_int (Char.code c7) in
let n6 = Int64.of_int (Char.code c6) in
let n5 = Int64.of_int (Char.code c5) in
let n4 = Int64.of_int (Char.code c4) in
let n3 = Int64.of_int (Char.code c3) in
let n2 = Int64.of_int (Char.code c2) in
let n1 = Int64.of_int (Char.code c1) in
let n0 = Int64.of_int (Char.code c0) in
Int64.logor
(Int64.shift_left n7 56)
(Int64.logor
(Int64.shift_left n6 48)
(Int64.logor
(Int64.shift_left n5 40)
(Int64.logor
(Int64.shift_left n4 32)
(Int64.logor
(Int64.shift_left n3 24)
(Int64.logor
(Int64.shift_left n2 16)
(Int64.logor
(Int64.shift_left n1 8)
n0))))))
let mk_uint4 = mk_int4
let mk_uint8 = mk_int8
(**********************************************************************)
(* dest_[u]intn *)
(**********************************************************************)
(* compatibility interface *)
IFDEF WORDSIZE_64 THEN
let dest_int4 x =
let n3 = (x lsr 24) land 0xff in
let n2 = (x lsr 16) land 0xff in
let n1 = (x lsr 8) land 0xff in
let n0 = x land 0xff in
(Char.chr n3, Char.chr n2, Char.chr n1, Char.chr n0)
ELSE
let dest_int4 x =
let n3 = Int32.to_int (Int32.shift_right_logical x 24) land 0xff in
let n2 = Int32.to_int (Int32.shift_right_logical x 16) land 0xff in
let n1 = Int32.to_int (Int32.shift_right_logical x 8) land 0xff in
let n0 = Int32.to_int (Int32.logand x 0xffl) in
(Char.chr n3, Char.chr n2, Char.chr n1, Char.chr n0)
END
let dest_int8 x =
let n7 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 56)
0xffL) in
let n6 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 48)
0xffL) in
let n5 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 40)
0xffL) in
let n4 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 32)
0xffL) in
let n3 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 24)
0xffL) in
let n2 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 16)
0xffL) in
let n1 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 8)
0xffL) in
let n0 = Int64.to_int (Int64.logand x 0xffL) in
(Char.chr n7, Char.chr n6, Char.chr n5, Char.chr n4,
Char.chr n3, Char.chr n2, Char.chr n1, Char.chr n0)
let dest_uint4 = dest_int4
let dest_uint8 = dest_int8
(**********************************************************************)
(* int_of_[u]intn *)
(**********************************************************************)
let c_max_int_64 = Int64.of_int max_int
let c_min_int_64 = Int64.of_int min_int
let name_int_of_int4 = "int_of_int4"
IFDEF WORDSIZE_64 THEN
let int_of_int4 x = x
ELSE
let int_of_int4 x =
if x < (-0x4000_0000l) || x > 0x3fff_ffffl then
cannot_represent name_int_of_int4;
Int32.to_int x
END
let name_int_of_uint4 = "int_of_uint4"
IFDEF WORDSIZE_64 THEN
let int_of_uint4 x =
(* x land 0xffff_ffff - "Integer literal exceeds the range..." grrrmpf *)
(x lsl 31) lsr 31
ELSE
let int_of_uint4 x =
if x >= 0l && x <= 0x3fff_ffffl then
Int32.to_int x
else
cannot_represent name_int_of_uint4
END
let name_int_of_int8 = "int_of_int8"
let int_of_int8 x =
if x >= c_min_int_64 && x <= c_max_int_64 then
Int64.to_int x
else
cannot_represent name_int_of_int8
let name_int_of_uint8 = "int_of_uint8"
let int_of_uint8 x =
if x >= Int64.zero && x <= c_max_int_64 then
Int64.to_int x
else
cannot_represent name_int_of_uint8
(**********************************************************************)
(* intn_of_int *)
(**********************************************************************)
let name_int4_of_int = "int4_of_int"
IFDEF WORDSIZE_64 THEN
let int4_of_int i =
let j = i asr 31 in
if j = 0 || j = (-1) then
i
else
cannot_represent name_int4_of_int
ELSE
let int4_of_int i =
Int32.of_int i
END
let name_uint4_of_int = "uint4_of_int"
IFDEF WORDSIZE_64 THEN
let uint4_of_int i =
let j = i asr 32 in
if j = 0 then
(i lsl 31) asr 31 (* fix sign *)
else
cannot_represent name_uint4_of_int
ELSE
let uint4_of_int i =
if i >= 0 then
Int32.of_int i
else
cannot_represent name_uint4_of_int
END
let int8_of_int = Int64.of_int
let name_uint8_of_int = "uint8_of_int"
let uint8_of_int i =
if i >= 0 then
Int64.of_int i
else
cannot_represent name_uint8_of_int
(**********************************************************************)
(* Int32 and Int64 support: int[32|64]_of_[u]intn *)
(**********************************************************************)
IFDEF WORDSIZE_64 THEN
let int32_of_int4 x = Int32.of_int x
ELSE
let int32_of_int4 x = x
END
let name_int32_of_uint4 = "int32_of_uint4"
IFDEF WORDSIZE_64 THEN
let int32_of_uint4 x =
if x >= 0 then
Int32.of_int x
else
cannot_represent name_int32_of_uint4
ELSE
let int32_of_uint4 x =
if x >= 0l then
x
else
cannot_represent name_int32_of_uint4
END
let c_int32_min_int_64 = Int64.of_int32 Int32.min_int
let c_int32_max_int_64 = Int64.of_int32 Int32.max_int
let name_int32_of_int8 = "int32_of_int8"
let int32_of_int8 x =
if x >= (-0x8000_0000L) && x <= 0x7fff_0000L then
Int64.to_int32 x
else
cannot_represent name_int32_of_int8
let name_int32_of_uint8 = "int32_of_uint8"
let int32_of_uint8 x =
if x >= 0L && x <= 0x7fff_0000L then
Int64.to_int32 x
else
cannot_represent name_int32_of_uint8
IFDEF WORDSIZE_64 THEN
let int64_of_int4 = Int64.of_int
ELSE
let int64_of_int4 = Int64.of_int32
END
IFDEF WORDSIZE_64 THEN
let int64_of_uint4 x =
if x >= 0 then
Int64.of_int x
else
Int64.add (Int64.of_int x) 0x1_0000_0000L
ELSE
let int64_of_uint4 x =
if x >= 0l then
Int64.of_int32 x
else
Int64.add (Int64.of_int32 x) 0x1_0000_0000L
END
let int64_of_int8 x = x
let name_int64_of_uint8 = "int64_of_uint8"
let int64_of_uint8 x =
if x >= 0L then
x
else
cannot_represent name_int64_of_uint8
(**********************************************************************)
(* Int32 and Int64 support: [u]intn_of_int[32|64] *)
(**********************************************************************)
IFDEF WORDSIZE_64 THEN
let int4_of_int32 = Int32.to_int
ELSE
let int4_of_int32 x = x
END
let name_uint4_of_int32 = "uint4_of_int32"
let uint4_of_int32 i =
if i < 0l then
cannot_represent name_uint4_of_int32;
int4_of_int32 i
let int8_of_int32 =
Int64.of_int32
let name_uint8_of_int32 = "uint8_of_int32"
let uint8_of_int32 i =
if i < 0l then
cannot_represent name_uint8_of_int32;
Int64.of_int32 i
let name_int4_of_int64 = "int4_of_int64"
IFDEF WORDSIZE_64 THEN
let int4_of_int64 i =
if i >= (-0x8000_0000L) && i <= 0x7fff_ffffL then
Int64.to_int i
else cannot_represent name_int4_of_int64
ELSE
let int4_of_int64 i =
if i >= (-0x8000_0000L) && i <= 0x7fff_ffffL then
Int64.to_int32 i
else cannot_represent name_int4_of_int64
END
let name_uint4_of_int64 = "uint4_of_int64"
let uint4_of_int64 i =
if i < 0L || i > 0xffff_ffffL then
cannot_represent name_uint4_of_int64;
IFDEF WORDSIZE_64 THEN
Int64.to_int(Int64.shift_right (Int64.shift_left i 32) 32) (* sign! *)
ELSE
Int64.to_int32 i
END
let int8_of_int64 i = i
let name_uint8_of_int64 = "uint8_of_int64"
let uint8_of_int64 i =
if i < 0L then
cannot_represent name_uint8_of_int64;
i
(**********************************************************************)
(* logical_xxx_of_xxx *)
(**********************************************************************)
IFDEF WORDSIZE_64 THEN
let logical_uint4_of_int32 x = Int32.to_int x
let logical_int32_of_uint4 x = Int32.of_int x
ELSE
let logical_uint4_of_int32 x = x
let logical_int32_of_uint4 x = x
END
let logical_uint8_of_int64 x = x
let logical_int64_of_uint8 x = x
(**********************************************************************)
(* min/max *)
(**********************************************************************)
let min_int4 = int4_of_int32 Int32.min_int
let min_uint4 = uint4_of_int 0
let min_int8 = int8_of_int64 Int64.min_int
let min_uint8 = uint8_of_int 0
let max_int4 = int4_of_int32 Int32.max_int
let max_uint4 = logical_uint4_of_int32 (-1l)
let max_int8 = int8_of_int64 Int64.max_int
let max_uint8 = logical_uint8_of_int64 (-1L)
(**********************************************************************)
(* floating point *)
(**********************************************************************)
let fp8_of_fp4 x =
(* Requires O'Caml >= 3.08 *)
Int64.bits_of_float (Int32.float_of_bits x)
let fp4_of_fp8 x =
(* Requires O'Caml >= 3.08 *)
Int32.bits_of_float (Int64.float_of_bits x)
let float_of_fp8 x =
(* Requires O'Caml >= 3.01 *)
Int64.float_of_bits x
let float_of_fp4 x =
(* Requires O'Caml >= 3.08 *)
Int32.float_of_bits x
(* Old:
* float_of_fp8 (fp8_of_fp4 x)
*)
let fp8_of_float x =
(* Requires O'Caml >= 3.01 *)
Int64.bits_of_float x
let fp4_of_float x =
(* Requires O'Caml >= 3.08 *)
Int32.bits_of_float x
(* Old:
* fp4_of_fp8 (fp8_of_float x)
*)
let mk_fp4 x = int32_of_int4 (mk_int4 x)
let mk_fp8 = mk_int8
let dest_fp4 x = dest_int4 (int4_of_int32 x)
let dest_fp8 = dest_int8
module BE : ENCDEC = struct
(**********************************************************************)
(* read_[u]intn *)
(**********************************************************************)
IFDEF WORDSIZE_64 THEN
IFDEF USE_NETSYS_XDR THEN
let read_int4_unsafe =
Netsys_xdr.s_read_int4_64_unsafe
ELSE
let read_int4_unsafe s pos =
let n3 = Char.code (String.unsafe_get s pos) in
let x = (n3 lsl 55) asr 31 in (* sign! *)
let n2 = Char.code (String.unsafe_get s (pos+1)) in
let x = x lor (n2 lsl 16) in
let n1 = Char.code (String.unsafe_get s (pos+2)) in
let x = x lor (n1 lsl 8) in
let n0 = Char.code (String.unsafe_get s (pos+3)) in
x lor n0
END
ELSE
let read_int4_unsafe s pos =
let n3 = Int32.of_int (Char.code (String.unsafe_get s pos)) in
let x = Int32.shift_left n3 24 in
let n2 = Int32.of_int (Char.code (String.unsafe_get s (pos+1))) in
let x = Int32.logor x (Int32.shift_left n2 16) in
let n1 = Int32.of_int (Char.code (String.unsafe_get s (pos+2))) in
let x = Int32.logor x (Int32.shift_left n1 8) in
let n0 = Int32.of_int (Char.code (String.unsafe_get s (pos+3))) in
Int32.logor x n0
END
(*
seems to be slightly better than
Int32.logor
(Int32.shift_left n3 24)
(Int32.logor
(Int32.shift_left n2 16)
(Int32.logor
(Int32.shift_left n1 8)
n0))
*)
let read_int4 s pos =
if pos < 0 || pos + 4 > String.length s then
raise Out_of_range;
read_int4_unsafe s pos
IFDEF WORDSIZE_64 THEN
IFDEF USE_NETSYS_XDR THEN
DEFINE FAST_READ_INT8
END
END
IFDEF FAST_READ_INT8 THEN
let read_int8_unsafe s pos =
let x1 = Netsys_xdr.s_read_int4_64_unsafe s pos in
let x0 = Netsys_xdr.s_read_int4_64_unsafe s (pos+4) in
Int64.logor
(Int64.logand (Int64.of_int x0) 0xFFFF_FFFFL)
(Int64.shift_left (Int64.of_int x1) 32)
ELSE
let read_int8_unsafe s pos =
let n7 = Int64.of_int (Char.code (String.unsafe_get s pos)) in
let x = Int64.shift_left n7 56 in
let n6 = Int64.of_int (Char.code (String.unsafe_get s (pos+1))) in
let x = Int64.logor x (Int64.shift_left n6 48) in
let n5 = Int64.of_int (Char.code (String.unsafe_get s (pos+2))) in
let x = Int64.logor x (Int64.shift_left n5 40) in
let n4 = Int64.of_int (Char.code (String.unsafe_get s (pos+3))) in
let x = Int64.logor x (Int64.shift_left n4 32) in
let n3 = Int64.of_int (Char.code (String.unsafe_get s (pos+4))) in
let x = Int64.logor x (Int64.shift_left n3 24) in
let n2 = Int64.of_int (Char.code (String.unsafe_get s (pos+5))) in
let x = Int64.logor x (Int64.shift_left n2 16) in
let n1 = Int64.of_int (Char.code (String.unsafe_get s (pos+6))) in
let x = Int64.logor x (Int64.shift_left n1 8) in
let n0 = Int64.of_int (Char.code (String.unsafe_get s (pos+7))) in
Int64.logor x n0
END
let read_int8 s pos =
if pos < 0 || pos + 8 > String.length s then
raise Out_of_range;
read_int8_unsafe s pos
let read_uint4 = read_int4
let read_uint8 = read_int8
let read_uint4_unsafe = read_int4_unsafe
let read_uint8_unsafe = read_int8_unsafe;;
(**********************************************************************)
(* write_[u]intn *)
(**********************************************************************)
IFDEF WORDSIZE_64 THEN
IFDEF USE_NETSYS_XDR THEN
let write_int4_unsafe =
Netsys_xdr.s_write_int4_64_unsafe
ELSE
let write_int4_unsafe s pos x =
let n3 = (x lsr 24) land 0xff in
String.unsafe_set s pos (Char.unsafe_chr n3);
let n2 = (x lsr 16) land 0xff in
String.unsafe_set s (pos+1) (Char.unsafe_chr n2);
let n1 = (x lsr 8) land 0xff in
String.unsafe_set s (pos+2) (Char.unsafe_chr n1);
let n0 = x land 0xff in
String.unsafe_set s (pos+3) (Char.unsafe_chr n0);
()
END
ELSE
let write_int4_unsafe s pos x =
let n3 = Int32.to_int (Int32.shift_right_logical x 24) land 0xff in
String.unsafe_set s pos (Char.unsafe_chr n3);
let n2 = Int32.to_int (Int32.shift_right_logical x 16) land 0xff in
String.unsafe_set s (pos+1) (Char.unsafe_chr n2);
let n1 = Int32.to_int (Int32.shift_right_logical x 8) land 0xff in
String.unsafe_set s (pos+2) (Char.unsafe_chr n1);
let n0 = Int32.to_int (Int32.logand x 0xffl) in
String.unsafe_set s (pos+3) (Char.unsafe_chr n0);
()
END ;;
let write_int4 s pos x =
if pos < 0 || pos + 4 > String.length s then
raise Out_of_range;
write_int4_unsafe s pos x
IFDEF WORDSIZE_64 THEN
IFDEF USE_NETSYS_XDR THEN
DEFINE FAST_WRITE_INT8
END
END
IFDEF FAST_WRITE_INT8 THEN
let write_int8_unsafe s pos x =
Netsys_xdr.s_write_int4_64_unsafe s pos
(Int64.to_int (Int64.shift_right x 32));
Netsys_xdr.s_write_int4_64_unsafe s (pos+4)
(Int64.to_int (Int64.logand x 0xFFFF_FFFFL))
ELSE
let write_int8_unsafe s pos x =
let n7 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 56)
0xffL) in
String.unsafe_set s pos (Char.unsafe_chr n7);
let n6 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 48)
0xffL) in
String.unsafe_set s (pos+1) (Char.unsafe_chr n6);
let n5 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 40)
0xffL) in
String.unsafe_set s (pos+2) (Char.unsafe_chr n5);
let n4 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 32)
0xffL) in
String.unsafe_set s (pos+3) (Char.unsafe_chr n4);
let n3 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 24)
0xffL) in
String.unsafe_set s (pos+4) (Char.unsafe_chr n3);
let n2 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 16)
0xffL) in
String.unsafe_set s (pos+5) (Char.unsafe_chr n2);
let n1 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 8)
0xffL) in
String.unsafe_set s (pos+6) (Char.unsafe_chr n1);
let n0 = Int64.to_int (Int64.logand x 0xffL) in
String.unsafe_set s (pos+7) (Char.unsafe_chr n0);
()
END
let write_int8 s pos x =
if pos < 0 || pos + 8 > String.length s then
raise Out_of_range;
write_int8_unsafe s pos x
let write_uint4 = write_int4
let write_uint8 = write_int8
let write_uint4_unsafe = write_int4_unsafe
let write_uint8_unsafe = write_int8_unsafe
(**********************************************************************)
(* [u]intn_as_string *)
(**********************************************************************)
let int4_as_string x =
let s = String.create 4 in
write_int4 s 0 x;
s
let uint4_as_string x =
let s = String.create 4 in
write_uint4 s 0 x;
s
let int8_as_string x =
let s = String.create 8 in
write_int8 s 0 x;
s
let uint8_as_string x =
let s = String.create 8 in
write_int8 s 0 x;
s
(**********************************************************************)
(* floating-point numbers *)
(**********************************************************************)
let fp4_as_string x = int4_as_string (int4_of_int32 x)
let fp8_as_string x = int8_as_string (int8_of_int64 x)
let read_fp4 s pos =
int32_of_int4(read_int4 s pos)
let read_fp8 s pos =
int64_of_int8(read_int8 s pos)
let write_fp4 s pos x =
write_int4 s pos (int4_of_int32 x)
let write_fp8 s pos x =
write_int8 s pos (int8_of_int64 x)
end
module LE : ENCDEC = struct
(**********************************************************************)
(* read_[u]intn *)
(**********************************************************************)
IFDEF WORDSIZE_64 THEN
(*
IFDEF USE_NETSYS_XDR THEN
let read_int4_unsafe =
Netsys_xdr.s_read_int4_64_unsafe (* FIXME *)
ELSE
*)
let read_int4_unsafe s pos =
let n3 = Char.code (String.unsafe_get s (pos+3)) in
let x = (n3 lsl 55) asr 31 in (* sign! *)
let n2 = Char.code (String.unsafe_get s (pos+2)) in
let x = x lor (n2 lsl 16) in
let n1 = Char.code (String.unsafe_get s (pos+1)) in
let x = x lor (n1 lsl 8) in
let n0 = Char.code (String.unsafe_get s pos) in
x lor n0
(* END *)
ELSE
let read_int4_unsafe s pos =
let n3 = Int32.of_int (Char.code (String.unsafe_get s (pos+3))) in
let x = Int32.shift_left n3 24 in
let n2 = Int32.of_int (Char.code (String.unsafe_get s (pos+2))) in
let x = Int32.logor x (Int32.shift_left n2 16) in
let n1 = Int32.of_int (Char.code (String.unsafe_get s (pos+1))) in
let x = Int32.logor x (Int32.shift_left n1 8) in
let n0 = Int32.of_int (Char.code (String.unsafe_get s pos)) in
Int32.logor x n0
END
let read_int4 s pos =
if pos < 0 || pos + 4 > String.length s then
raise Out_of_range;
read_int4_unsafe s pos
let read_int8_unsafe s pos =
let n7 = Int64.of_int (Char.code (String.unsafe_get s (pos+7))) in
let x = Int64.shift_left n7 56 in
let n6 = Int64.of_int (Char.code (String.unsafe_get s (pos+6))) in
let x = Int64.logor x (Int64.shift_left n6 48) in
let n5 = Int64.of_int (Char.code (String.unsafe_get s (pos+5))) in
let x = Int64.logor x (Int64.shift_left n5 40) in
let n4 = Int64.of_int (Char.code (String.unsafe_get s (pos+4))) in
let x = Int64.logor x (Int64.shift_left n4 32) in
let n3 = Int64.of_int (Char.code (String.unsafe_get s (pos+3))) in
let x = Int64.logor x (Int64.shift_left n3 24) in
let n2 = Int64.of_int (Char.code (String.unsafe_get s (pos+2))) in
let x = Int64.logor x (Int64.shift_left n2 16) in
let n1 = Int64.of_int (Char.code (String.unsafe_get s (pos+1))) in
let x = Int64.logor x (Int64.shift_left n1 8) in
let n0 = Int64.of_int (Char.code (String.unsafe_get s pos)) in
Int64.logor x n0
let read_int8 s pos =
if pos < 0 || pos + 8 > String.length s then
raise Out_of_range;
read_int8_unsafe s pos
let read_uint4 = read_int4
let read_uint8 = read_int8
let read_uint4_unsafe = read_int4_unsafe
let read_uint8_unsafe = read_int8_unsafe;;
(**********************************************************************)
(* write_[u]intn *)
(**********************************************************************)
IFDEF WORDSIZE_64 THEN
(*
IFDEF USE_NETSYS_XDR THEN
let write_int4_unsafe =
Netsys_xdr.s_write_int4_64_unsafe
ELSE
*)
let write_int4_unsafe s pos x =
let n3 = (x lsr 24) land 0xff in
String.unsafe_set s (pos+3) (Char.unsafe_chr n3);
let n2 = (x lsr 16) land 0xff in
String.unsafe_set s (pos+2) (Char.unsafe_chr n2);
let n1 = (x lsr 8) land 0xff in
String.unsafe_set s (pos+1) (Char.unsafe_chr n1);
let n0 = x land 0xff in
String.unsafe_set s pos (Char.unsafe_chr n0);
()
(* END *)
ELSE
let write_int4_unsafe s pos x =
let n3 = Int32.to_int (Int32.shift_right_logical x 24) land 0xff in
String.unsafe_set s (pos+3) (Char.unsafe_chr n3);
let n2 = Int32.to_int (Int32.shift_right_logical x 16) land 0xff in
String.unsafe_set s (pos+2) (Char.unsafe_chr n2);
let n1 = Int32.to_int (Int32.shift_right_logical x 8) land 0xff in
String.unsafe_set s (pos+1) (Char.unsafe_chr n1);
let n0 = Int32.to_int (Int32.logand x 0xffl) in
String.unsafe_set s pos (Char.unsafe_chr n0);
()
END ;;
let write_int4 s pos x =
if pos < 0 || pos + 4 > String.length s then
raise Out_of_range;
write_int4_unsafe s pos x
let write_int8_unsafe s pos x =
let n7 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 56)
0xffL) in
String.unsafe_set s (pos+7) (Char.unsafe_chr n7);
let n6 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 48)
0xffL) in
String.unsafe_set s (pos+6) (Char.unsafe_chr n6);
let n5 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 40)
0xffL) in
String.unsafe_set s (pos+5) (Char.unsafe_chr n5);
let n4 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 32)
0xffL) in
String.unsafe_set s (pos+4) (Char.unsafe_chr n4);
let n3 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 24)
0xffL) in
String.unsafe_set s (pos+3) (Char.unsafe_chr n3);
let n2 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 16)
0xffL) in
String.unsafe_set s (pos+2) (Char.unsafe_chr n2);
let n1 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 8)
0xffL) in
String.unsafe_set s (pos+1) (Char.unsafe_chr n1);
let n0 = Int64.to_int (Int64.logand x 0xffL) in
String.unsafe_set s pos (Char.unsafe_chr n0);
()
let write_int8 s pos x =
if pos < 0 || pos + 8 > String.length s then
raise Out_of_range;
write_int8_unsafe s pos x
let write_uint4 = write_int4
let write_uint8 = write_int8
let write_uint4_unsafe = write_int4_unsafe
let write_uint8_unsafe = write_int8_unsafe
(**********************************************************************)
(* [u]intn_as_string *)
(**********************************************************************)
let int4_as_string x =
let s = String.create 4 in
write_int4 s 0 x;
s
let uint4_as_string x =
let s = String.create 4 in
write_uint4 s 0 x;
s
let int8_as_string x =
let s = String.create 8 in
write_int8 s 0 x;
s
let uint8_as_string x =
let s = String.create 8 in
write_int8 s 0 x;
s
(**********************************************************************)
(* floating-point numbers *)
(**********************************************************************)
let fp4_as_string x = int4_as_string (int4_of_int32 x)
let fp8_as_string x = int8_as_string (int8_of_int64 x)
let read_fp4 s pos =
int32_of_int4(read_int4 s pos)
let read_fp8 s pos =
int64_of_int8(read_int8 s pos)
let write_fp4 s pos x =
write_int4 s pos (int4_of_int32 x)
let write_fp8 s pos x =
write_int8 s pos (int8_of_int64 x)
end
IFDEF HOST_IS_BIG_ENDIAN THEN
module HO = BE
ELSE
module HO = LE
END
